	TITLE	MICRO BASIC
**************************************************************
*                       MICRO-BASIC                          *
*------------------------------------------------------------*
*   A SMALL INTEGER BASIC INTERPRETER FOR THE 8080/8085/Z80  *
*                                D.F. DUNFIELD  JAN 25/1983  *
*------------------------------------------------------------*
*                      BASIC COMMANDS                        *
*                                                            *
*  CLEAR,    DATA,     DIM,      END,      EXIT,     FOR,    *
*  GOSUB,    GOSUB(N), GOTO,     GOTO(N),  IF/THEN,  INPUT,  *
*  LET,      LIF/THEN, LIST,     LOAD,     NEW,      NEXT,   *
*  ORDER,    PLOT,     PRINT,    READ,     REM,      RETURN, *
*  RUN,      SAVE,     SIZE,     STOP,     USR,      <EDIT>  *
*------------------------------------------------------------*
*                     BASIC OPERATORS                        *
*                                                            *
* NUMERIC:     + - * % / \ & | ; ( ) < = > == -= <= >=       *
* CHARACTER:   + = == -=                                     *
* OTHER:       : # $ @ ? [ ] ( )                             *
*------------------------------------------------------------*
*                      BASIC VARIABLES                       *
*                                                            *
*     A - Z ......... 16 BIT SIMPLE INTEGER VARIABLES.       *
*     A$ - Z$ ....... SIMPLE CHARACTER VARIABLES. < 36 CHARS *
*     A[N] - Z[N] ... 16 BIT INTEGER ARRAYS.                 *
*     @[N] .......... PSEUDO MEMORY REFERENCE ARRAY.         *
*     @[N]$ ......... NUMERIC TO CHARACTER CONVERSION.(CHR$) *
*     ? ............. PSEUDO RANDOM NUMBER GENERATOR.        *
*------------------------------------------------------------*
*                        MEMORY MAP                          *
*                                                            *
*    0000-03FF     1K SYSTEM MONITOR (IN ROM).               *
*    0400-0FFF     3K BASIC INTERPRETER (IN ROM).            *
*    1000-13FF     1K MEMORY MAPPED 64*16 VIDEO DISPLAY      *
*    1400-15FF     0.5K POINTERS, STACKS, BUFFERS.           *
*    1600-19FF     1K VARIABLES AND POINTERS.                *
*    1A00-FFFF     PROGRAM AND ARRAY STORAGE.                *
**************************************************************
	PAGE
*
**************************************************************
*                   CONSTANTS AND EQUATES
**************************************************************
*
* MONITOR ROUTINES
*
;IN	EQU	$23F		INPUT ROUTINE ADDRESS
;OUT	EQU	$162		OUTPUT ROUTINE ADDRESS
;CTRLC	EQU	$27E		CONTROL-C TEST ROUTINE ADDRESS
;EXIT	EQU	$37		TERMINATION RETURN ADDRESS
* MEMORY ALLOCATION
BUFF	EQU	$3C00		START OF RAM, INPUT BUFFER
IOCON	EQU	BUFF+$FF	INPUT/OUTPUT CONFIGURATION
USROUT	EQU	IOCON-2		USER SUPPLIED OUTPUT DEVICE VECTOR
CURSOR	EQU	USROUT-2	CURSOR POSITION
LSTCHR	EQU	CURSOR-2	CHARACTER UNDER CURSOR
STACK	EQU	LSTCHR-2	MACHINE STACK
TB	EQU	BUFF+50		TEMPORARY TEXT BUFFER
XBF	EQU	TB+50		EXTRA TEXT BUFFER
EDBUF	EQU	BUFF+256	EDIT BUFFER
CS	EQU	EDBUF+$FA	CONTROL STACK SPACE
CSP	EQU	CS+1		CONTROL STACK POINTER
ARYLOC	EQU	CSP+2		LOCATION OF ARRAYS
SEED	EQU	ARYLOC+1	RANDOM NUMBER SEED
VARS	EQU	SEED+2		VARIABLE SPACE
RFLAG	EQU	VARS+52		PROGRAM RUNNING FLAG
IFLAG	EQU	RFLAG+1		INPUTTING FLAG
P	EQU	IFLAG+1		POINTER TO END OF EXPRESSION
EFLAG	EQU	P+1		ASSIGNMENT FLAG
DATA	EQU	EFLAG+1		READ/DATA POINTER
LAST	EQU	DATA+2		LAST FREE ARRAY SPACE
TEMP	EQU	LAST+2		TEMPORARY STORAGE
TEXT	EQU	VARS+1024	PROGRAM AND ARRAY STORAGE
DELETE	EQU	$7F		DELETE CHARACTER
	PAGE
*
********************************************************************
* START OF MAIN PROGRAM, FIRST INITIALIZE, INSURING WE DON'T THINK *
* WE HAVE A VALID PROGRAM, ALSO CLEAR OUT HIS VARIABLES AND ARRAYS *
********************************************************************
*
	ORG	$3000		FOLLOW MONITOR
;BASIC	MVI	A,$0C		CHARACTER TO CLEAR SCREEN
;	CALL	OUT		CLEAR VIDEO SCREEN
NEW	MVI	A,$FF		INDICATES END OF PROGRAM
	STA	TEXT		INITIALIZE TO NO PROGRAM
RESV	CALL	CLEAR		CLEAR OUT HIS VARIABLES
* RESET FLAGS, AND PROMPT WITH 'READY', SO HE WILL KNOW WE ARE LISTENING
INIT	LXI	H,0		GET DOUBLE BYTE ZERO
	SHLD	RFLAG		INDICATE NOT RUNNING, AND NOT INPUT
	SHLD	P		INDICATE NO ASSIGNMENT DONE
	LXI	H,RDY		ADDRESS OF 'READY' MESSAGE
	CALL	PMSG		TELL HIM WE ARE READY
* GET A LINE FROM CONSOLE, AND SEE WHAT HE WANTS
TOP	LXI	SP,STACK	FIX UP STACK IN CASE WE ABORTED SOMETHING
	CALL	GLINE		LET HIM GIVE US A LINE
	CPI	$0D		DID HE ONLY PRESS RETURN
	JZ	TOP		NOT GOOD ENOUGH, MAKE HIM TRY AGAIN
	CALL	NUM		DID HIS LINE START WITH A NUMBER
	JNC	EDIT		IF SO, HE IS WRITEING A PROGRAM!!!
* LOOK UP COMMAND AND EXECUTE
	LXI	B,INIT		ADDRESS TO RETURN TO
	PUSH	B		SAVE SO WE CAN RETURN
	LXI	H,KTAB-1	POINT TO COMMAND TABLE
*
* LOCATES COMMAND POINTED TO BY D-E IN THE COMMAND TABLE POINTED TO BY H-L
* AND CHAINS TO THE COMMAND PROCESSING CODE FOR THAT COMMAND
*
CMD	CALL	PARSE1		ADVANCE TO NEXT CHARACTER
TLP0	PUSH	D		SAVE POINTER TO START OF COMMAND
CMDL	INX	H		ADVANCE IN TABLE
	LDAX	D		GET DATA FROM COMMAND
	CMP	M		COMPARE WITH TABLE CONTENTS
	INX	D		ADVANCE IN COMMAND
	JZ	CMDL		IF SAME, KEEP TESTING
* DIDN'T MATCH, SEE IF IT'S END OF WORD (HIGH BIT SET)
	ORI	$80		ARE WE AT END?
	CMP	M		AND IS IT THIS ONE?
	JZ	GOTCMD		IF SO, WE HAVE IT
* WASN'T THAT ENTRY, KEEP LOOKING
	SUB	A		SEE IT THIS IS END OF TABLE
	CMP	M		ARE WE AT END?
	JZ	GOTDEF		IF SO, WE WILL SAY WE FOUND
	POP	D		RESTORE POINTER TO COMMAND
CMD1	ORA	M		TEST FOR AT END OF TABLE ENTRY
	INX	H		POINT TO NEXT
	JP	CMD1		IF NO, KEEP LOOKING
	INX	H		SKIP FIRST ADDRESS BYTE
	JMP	TLP0		TEST THIS ENTRY
* WE HIT THE END OF THE TABLE, ASSUME THE DEFAULT ADDRESS (LET)
GOTDEF	DCX	D		BACKUP TO START OF WORD
* WE MATCHED ALL THE WAY TO THE END OF A COMMAND WORD, GET IT'S ADDRESS
GOTCMD	INX	H		POINT TO ADDRESS BYTE
	MOV	C,M		SAVE TEMPORARY
	INX	H		POINT TO NEXT ADDRESS BYTE
	MOV	H,M		GET LOW ADDRESS
	MOV	L,C		GET HIGH ADDRESS
	XTHL			PLACE CODE ADDRESS ON STACK, REMOVE TRASH
	JMP	PARSE1		SKIP TO NEXT NON-BLANK, AND CHAIN TO CODE
*
****************************************************************
*              ERROR CHECKING AND HANDLING CODE
****************************************************************
*
* VCHAR... TESTS FOR A VALID VARIABLE, SYNTAX ERROR IF NOT
*
VCHAR	CALL	CHAR		TEST VARIABLE
	RNC			IF OK, GO BACK
*
* SYNTAX ERROR... HE'S NOT MAKEING ANY SENSE AT ALL
* ISSUE NASTY MESSAGE TO STRAIGHTEN HIM OUT
*
SYNT	LXI	H,SYN		GET NASTY 'SYNTAX' MESSAGE
	DCX	D		BACK UP IN SOURCE SO WE DONT SAY WRONG LINE
*
* ERROR STUFF... SOMETHING HAS GONE WRONG... TELL HIM THE BAD NEWS AND
* QUIT ANYTHING THAT WE MAY HAVE STARTED, SO THAT THINGS CAN'T GET WORSE
* ALSO, IF WE WERE RUNNING, GIVE HIM THE LINE NUMBER AS A CLUE
*
ERR	MVI	A,'?'		PRECEDE ERROR MESSAGE BY '?'
	CALL	OUT		DISPLAY ON TERMINAL
	LDA	IFLAG		WERE WE TRYING TO 'INPUT' SOMETHING
	ANA	A		IF WE WERE, THEN ..
	JNZ	INERR		SPECIAL MESSAGE + HANDLEING
* NOW THAT WE HAVE FIGURED OUT WHAT'S GOING ON, LET HIM IN ON IT
	CALL	PMSG		PRINT ERROR MESSAGE
	LXI	H,EM		FOLLOWED BY..
* PRINT MESSAGE FOLLOWED BY LINE NUMBER (ALSO USED BY 'STOP IN LINE XXXX')
PERR	CALL	PMSG		THE ' ERROR ' PART
	LDA	RFLAG		WERE WE RUNNING..
	ANA	A		IF NOT,
	JZ	INLF		THEN THATS ALL WE HAVE TO DO
* DISPLAY LINE NUMBER OF RUNNING PROGRAM
	LXI	H,INL		ADDRESS OF 'IN LINE ' MESSAGE
	CALL	PMSG		DISPLAY FOR HIM
* FIND START OF OUR LINE, AND DISPLAY LINE NUMBER
FSOL	DCX	D		BACK UP IN SOURCE
	MOV	A,D		GET HIGH BYTE OF ADDRESS
	CPI	=TEXT		TEST FOR BEYOND BEGINNING
	JC	STLIN		AT START OF LINE
	LDAX	D		GET CHARACTER FROM BUFER
	CPI	$0D		TEST FOR CARRIAGE RETURN
	JNZ	FSOL		IF NOT, KEEP LOOKING
STLIN	INX	D		ADVANCE IN SOURCE
	XCHG			SWAP TO H-L FOR PNUM
	CALL	PNUM		PRINT AND BUFFER LINE NUMBER
* COPY LINE WITH ERROR INTO OLD LINE EDIT BUFFER, INCASE HE WANTS TO FIX IT
FIXIT	INX	H		SKIP LENGTH BYTE, ADVANCE TO NEXT IN SOURCE
	MOV	A,M		GET CHARACTER FROM LINE
	STAX	D		SAVE IN BUFFER
	INX	D		ADVANCE TO NEXT IN BUFFER
	CPI	$0D		TEST FOR END-OF-LINE
	JNZ	FIXIT		IF NOT, KEEP COPYING
* WAIT FOR CONSOLE INPUT, ON A NEW LINE
INLF	CALL	NL		ADVANCE A LINE ON HIS TERMINAL
inres	CALL	RESET		RESET DATA POINTER AND CONTROL-STACK
	JMP	INIT		GET NEXT COMMAND
*
* SUBROUTINE TEST FOR VALID ASCII DIGIT (0-9), RETURNS WITH C=1 IF NOT
*
NUM	CPI	'0'		TEST FOR < '0'
	RC			IF SO, BAD DIGIT
	CPI	$3A		TEST FOR >'9'
	CMC			INVERT LOGIC, C=1 IF BAD
	RET
*
****************************************************************
*                    TEXT EDITING ROUTINES
****************************************************************
*
* SUBROUTINE TO GET AND EDIT COMMAND LINE FROM TERMINAL
*
BADLN	CALL	NL		ADVANCE TO NEW LINE
GLINE	LXI	D,BUFF		POINT TO INPUT BUFFER
	LXI	H,EDBUF		POINT TO EDIT BUFFER
	MOV	B,E		CLEAR INSERT FLAG (LOW ADR OF BUFFER IS ZERO)
LOOP1	MOV	A,E		GET LOW ADDRESS OF OUR POSITION
	ANA	A		TEST FOR NEGATIVE
	JM	BADLN		IF SO, HE'S DELETED BEYOND START OF BUFFER
	CALL	IN		GET A CHARACTER
	CPI	3		TEST FOR CONTROL-C (CANCEL)
	JZ	INLF		IF SO, ABORT BACK TO COMMAND HANDLER
	CPI	6		TEST FOR CONTROL-F (FIND COMMAND)
	JZ	GFIND		EXECUTE FIND
	CPI	1		TEST FOR CONTROL-A (ADVANCE COMMAND)
	JZ	GADV		EXECUTE ADVANCE
	CPI	9		TEST FOR CONTROL-I (TOGGLE INSERT MODE)
	JZ	GINST		TOGGLE INSERT MODE
	CPI	4		TEST FOR CONTROL-D (DELETE CHARACTER.)
	JZ	GRUB		ERASE CHARACTER
	CPI	' '		TEST FOR CONTROL-CHARACTER
	JNC	OKPRT		IF NOT, OK TO PROCESS
	CPI	$0D		CARRIAGE RETURN IS OK,
	JZ	OKPRT		SO PROCESS IT
	CPI	8		SO IS A BACKSPACE
	JNZ	LOOP1		ANYTHING ELSE SHOULD BE IGNORED
* WE HAVE GOTTEN A VALID CHARACTER
OKPRT	CPI	DELETE		TEST FOR DELETE CHARACTER
	JNZ	RECT		IF IT IS A DELETE,
	MVI	A,8		MAKE IT INTO A BACKSPACE
RECT	MOV	C,A		COPY INTO C
	CALL	OUT		DISPLAY ON TERMINAL
	DCX	D		ASSUME DELETE (BACKSPACE)
* DON'T DELETE CHARS FROM OLD LINE BUFFER IF WE ARE INSERTING
	ORA	B		TEST INSERT FLAG
	JM	IND		IF NOT, WE ARE INSERTING
	DCX	H		REDUCE OLD BUFFER POSITION
IND	MOV	A,C		GET CHARACTER BACK
	CPI	8		TEST FOR DELETE (BACKSPACE)
	JZ	LOOP1		IF SO, WE WERE RIGHT, GET NEXT CHARACTER
	INX	D		FIX OUR MISTAKE (NOT DELETE)
	STAX	D		SAVE CHARACTER IN BUFFER
* DON'T MOVE OLD LINE POINTER IF WE ARE INSERTING
	ORA	B		TEST INSERT FLAG
	JM	INOK		IF SO, DON'T INCREMENT
	INX	H		ADVANCE IN OLD LINE BUFFER
	MOV	A,M		GET CHARACTER FROM OLD LINE
	CPI	$0D		TEST FOR END OF OLD LINE
	JZ	INOK		IF SO, DON'T GO PAST IT
	INX	H		ADVANCE TO NEXT CHARACTER OF OLD LINE
INOK	MOV	A,C		GET CHARACTER BACK
	INX	D		ADVANCE POINTER IN NEW LINE
	CPI	$0D		TEST FOR CARRAIGE RETURN (END OF LINE)
	JNZ	LOOP1		IF NOT, KEEP GETTING CHARACTERS
	CALL	NL		PRINT LINE-FEED CARRIAGE RETURN
* COPY NEW LINE INTO OLD LINE BUFFER (MAKEING IT THE 'NEW' OLD LINE)
	LXI	D,BUFF		POINT BACK TO NEW LINE BUFFER
	PUSH	D		SAVE BUFFER ADDRESS
	LXI	H,EDBUF		POINT TO OLD LINE BUFFER
MOVL	LDAX	D		GET CHARACTER FROM NEW LINE
	MOV	M,A		SAVE IN OLD LINE BUFFER
	INX	H		POINT TO NEXT
	INX	D		POINT TO NEXT
	CPI	$0D		TEST FOR END OF LINE
	JNZ	MOVL		IF NOT, KEEP MOVEING
	POP	D		RESTORE BUFFER ADDRESS
	LDAX	D		AND FIRST CHARACTER FROM IT
	RET
* COPY ONE CHARACTER FROM OLD LINE TO NEW LINE
GADV	MOV	A,M		GET CHARACTER FROM OLD LINE
	CPI	$0D		INSURE ITS NOT THE END
	JZ	LOOP1		IF SO, IGNORE COMMAND
	ORA	B		TEST INSERT FLAG
	MOV	A,M		GET CHARACTER BACK
	JP	RECT		IF NO INSERT, OK
	INX	H		ADVANCE TO NEXT
	JMP	RECT		PASS CHARACTER TO INPUT ROUTINE
* RUB OUT ONE CHARACTER FROM THE OLD LINE
GRUB	MOV	A,M		GET CHARACTER FROM OLD LINE
	CPI	$0D		TEST FOR END OF LINE
	JZ	LOOP1		IF SO, IGNORE COMMAND
	MVI	A,'*'		INDICATE RUBBED OUT CHARACTER WITH '*'
	CALL	OUT		PRINT  IT TO SHOW WHAT WE ARE DOING
	INX	H		ADVANCE PASSED CHARACTER (RUBBING IT OUT)
	JMP	LOOP1		RETURN FOR NEXT CHARACTER
* FIND NEXT CHARACTER IN NEW LINE
GFIND	CALL	IN		GET A CHARACTER
	MOV	C,A		SAVE IN C (TO COMPARE AGAINST.)
	PUSH	H		SAVE POSITION IN OLD LINE
* FIND OUT IF IT IS THERE..
GF1	MOV	A,M		GET CHARACTER FROM OLD LINE
GF0	CPI	$0D		TEST FOR END OF LINE
	JZ	ABFND		IF SO, WE DIDN'T FIND IT
	INX	H		ADVANCE TO NEXT CHARACTER
	MOV	A,M		GET CHARACTER
	CMP	C		TEST FOR CHARACTER WE DESIRE
	JNZ	GF0		IF NOT, KEEP LOOKING
	POP	H		RESTORE POSITION ON OLD LINE
* NOW COPY OLD LINE OVER..
GF2	MOV	A,M		GET CHARACTER FROM OLD LINE
GF3	STAX	D		SAVE IN NEW LINE
	CALL	OUT		DISPLAY ON TERMINAL
	INX	H		POINT TO NEXT CHAR. IN OLD LINE
	INX	D		POINT TO NEXT CHAR IN NEW LINE
	MOV	A,M		GET NEXT CHAR FROM NEW LINE
	CMP	C		TEST FOR CHARACTER WE WANT
	JNZ	GF3		IF NOT, KEEP COPYING
	PUSH	H		FIX UP STACK
ABFND	POP	H		RESTORE POSITION IN OLD LINE
	JMP	LOOP1		GET NEXT CHARACTER
* TOGGLE INSERT MODE
GINST	MOV	A,B		GET INSERT MODE FLAG
	XRI	$FF		COMPLEMENT, SETTING FLAGS
	MOV	B,A		REAVE IN FLAG REGISTER
	MVI	A,'<'		INDICATE ENTERING INSERT MODE
	JM	GIN1		IF SO, INDICATE SO
	MVI	A,'>'		INDICATE LEAVING INSERT
GIN1	CALL	OUT		DISPLAY INDICATOR ON TERMINAL
	JMP	LOOP1		GET NEXT CHARACTER FROM TERMINAL
*
* GET A PACKED-DECIMAL LINE NUMBER FROM THE COMMAND BUFFER
*
GETLN	LXI	H,0		START WITH ZERO
ELOOP	LDAX	D		GET DIGIT FROM COMMAND BUFFER
	CALL	NUM		TEST FOR ASCII DIGIT
	RC			IF NOT, STOP (WE HAVE IT)
	INX	D		ADVANCE TO NEXT BUFFER POSITION
	DAD	H		MAKE ROOM FOR DIGIT IN BOTTOM..
	DAD	H		OF THE RESULT, BY ..
	DAD	H		ROTATING IT..
	DAD	H		LEFT BY FOUR BITS
	ANI	$0F		CONVERT DIGIT TO BINARY
	ORA	L		INSERT INTO LOWER DIGITS OF RESULT
	MOV	L,A		AND REPLACE BYTE IN RESULT WITH NEW VALUE
	JMP	ELOOP		GET NEXT DIGIT
*
* LINE EDITOR, EDITS PROGRAM SOURCE BY LINE NUMBER IN COMMAND BUFFER
*
EDIT	CALL	LINEF		LOCATE LINE NUMBER IN SOURCE
	PUSH	H		SAVE POINTER INTO TEXT
	JNZ	INS		IF NEW LINE, DON'T TRY TO DELETE
* DELETE LINE POINTED TO BY H-L
DEL	MOV	D,H		COPY POINTER INTO
	MOV	E,L		THE D-E PAIR FOR BACKWARDS COPY
	MVI	A,$0D		WE ARE LOOKING FOR A CARRIAGE RETURN
* FIND START OF NEXT LINE
DELNX	CMP	M		TEST FOR END OF LINE TO DELETE
	INX	H		POINT TO NEXT CHARACTER IN SOURCE
	JNZ	DELNX		IF NOT END OF LINE, KEEP LOOKING
* COPY REST OF PROGRAM BACK OVER DELETED LINE
DELLP	MOV	A,M		GET CHARACTER FROM NEXT LINE
	STAX	D		SAVE OVER DELETED LINE
	INX	D		POINT TO NEXT IN NEW LINE
	INX	H		POINT TO NEXT IN OLD LINE
	INR	A		TEST FOR END OF FILE
	JNZ	DELLP		IF NOT, KEEP DELETEING
* INSERT LINE INTO TEXT
INS	LXI	B,2		SET LENGTH TO 2 (PACKED DECIMAL NUMBERS ARE 2)
	LXI	D,BUFF		POINT TO BUFFER (CONTAINING NEW LINE)
* CALCULATE LENGTH OF LINE
	CALL	GETLN		REMOVE NUMBERS AS THEY ARE NOT STORED AS TEXT
ILP	INR	C		INCREMENT LENGTH
	LDAX	D		GET CHARACTER FROM NEW LINE (IN BUFFER)
	INX	D		POINT TO NEXT CHARACTER FROM NEW LINE
	CPI	$0D		TEST FOR END OF LINE
	JNZ	ILP		IF NOT, KEEP COUNTING
	MOV	A,C		GET LENGTH
	POP	H		RESTORE POSITION IN TEXT
	CPI	3		TEST FOR NULL LINE
	JZ	TOP		IS SO, DON'T INSERT
* INSERT NEW LINE INTO TEXT
INLN	MOV	D,H		SET D-E TO POINT TO
	MOV	E,L		THE LINE POSITION
	CALL	GETEOF		GET END OF FILE ADDRESS
	INX	H		ADVANCE TO FREE BYTE
	PUSH	B		SAVE LENGTH
	PUSH	H		STACK END OF FILE ADDRESS
	DAD	B		ADD LENGTH
	POP	B		GET END OF FILE ADDRESS
	INX	H		ADVANCE BECAUSE WE DECREMENT
IL01	DCX	H		REDUCE POINTER INTO NEW POSITION
	DCX	B		REDUCE POINTER TO OLD POSITION
	LDAX	B		GET BYTE OF OLD DATA
	MOV	M,A		SAVE IN NEW POSITION
	MOV	A,C		GET LOW ADDRESS
	CMP	E		TEST AGAINST WHERE WE ARE GOING
	JNZ	IL01		IF NOT, KEEP COPYING
	MOV	A,B		GET HIGH ADDRESS
	CMP	D		TEST AGAINST DESTINATION
	JNZ	IL01		IF NOT SAME, KEEP COPYING
	LXI	D,BUFF		GET ADDRESS OF NEW LINE
	CALL	GETLN		OBTAIN NUMBERS
	MOV	A,H		GET HIGH 2 DIGITS
	STAX	B		SAVE IN NEW LINE
	INX	B		POINT TO NEXT CHARACTER OF NEW LINE
	MOV	A,L		GET LOW DIGITS
	STAX	B		SAVE IN NEW LINE
	INX	B		ADVANCE TO NEXT CHARACTER IN NEW LINE
	POP	H		RESTORE LENGTH
	MOV	A,L		GET LENGTH
	ADI	$10		ADD OFFSET TO MAKE UNIQUE
	STAX	B		SAVE IN NEW LINE
	INX	B		POINT TO NEXT CHARACTER
IL02	LDAX	D		GET CHARACTER FROM NEW LINE IN BUFFER
	STAX	B		SAVE IN TEXT
	INX	B		POINT TO NEXT POSITION IN TEXT
	INX	D		ADVANCE IN BUFFER
	CPI	$0D		TEST FOR END OF LINE
	JNZ	IL02		IF NOT, KEEP LOOKING
* WE ARE INSERTING OR REPLACEING A LINE, SINCE WE DON'T KNOW HOW MUCH
* MEMORY IT WILL REQUIRE, WE MUST CLEAR THE ARRAYS, AS THEY FOLLOW THE
* PROGRAM. WE DO NOT HAVE TO DO THIS WHEN DELETING LINES
	CALL	CLRARY		CLEAR ARRAYS AND RETURN
	JMP	TOP		GO BACK FOR NEXT COMMAND
*
* LOCATE LINE IN TEXT, SYNTAX ERROR IF NOT LINE NUMBER
*
FNDLIN	CALL	NUM		IS IT A VALID NUMBER
	JC	SYNT		IF NOT, IT'S A INVALID
*
* FINDS LINE IN PROGRAM TEXT. RETURNS WITH Z FLAG SET IF LINE EXISTS
* H-L POINTS TO START OF LINE. B-C CONTAINS LINE NUMBER OF ACTUAL
* LINE FOUND. (IF LINE NOT FOUND, POINTS TO FIRST GREATER LINE NUMBER)
*
LINEF	CALL	GETLN		GET LINE NUMBER FROM COMMAND BUFFER
	XCHG			SWAP TO D-E
	LXI	H,TEXT		START AT TOP OF PROGRAM
TRY	MOV	A,M		GET FIRST CHARACTER FROM PROGRAM LINE
	CPI	$FF		TEST FOR END OF FILE
	JZ	EOF		IF SO, WE DIDN'T FIND
	INX	H		ADVANCE POINTER TO LOW DIGITS
	CMP	D		TEST FOR HIGH DIGITS CORRECT
	JC	NEXTL		IF LESS, FIND NEXT LINE
	JNZ	NOTFND		IF GREATER, LINE WASN'T FOUND
	MOV	A,M		GET LOW DIGITS
	CMP	E		TEST LOW DIGITS
	JNC	NOTFND		IF LESS, LINE IS HERE OR DOSN'T EXIST
* ADVANCE TO NEXT LINE IN SOURCE
NEXTL	INX	H		POINT TO LINE LENGTH
	MOV	A,M		GET LENGTH
	SUI	$11		SUBTRACT OFFSET USED TO MAKE IT UNIQUE
	ADD	L		ADD TO POINTER
	MOV	L,A		AND REPLACE IN POINTER
	JNC	TRY		IF NO CARRY, THATS IT
	INR	H		BUMP HIGH ADDRESS
	JMP	TRY		AND TEST THIS LINE
* LINE IS HERE OR BEFORE
NOTFND	DCX	H		BACK UP TO DIGIT
	MOV	C,A		PLACE LOW ORDER DIGIT IN C
	MOV	B,M		PLACE HIGH ORDER DIGIT IN B
	CMP	E		TEST FOR LINE FOUND
	RNZ			IF NOT SAME, RETURN INDICATING SO
	MOV	A,B		GET HIGH DIGIT
	CMP	D		INDICATE IF NUMBERS SAME
	RET
* LINE WAS GREATER THAN ALL LINES IN PROGRAM, INDICATE EOF REACHED
EOF	MOV	B,A		RETURN HIGH LINE NUMBER
	ANA	A		INDICATE LINE DOSN'T EXIST
	RET
*
* PRINTS PACKED-DECIMAL LINE NUMBER ON TERMINAL, AS WELL AS PLACEING
* IT AT THE START OF THE EDIT BUFFER
*
PNUM	LXI	D,EDBUF		SET UP POINTER TO EDIT BUFFER
	CALL	HPOUT		PRINT FIRST TWO DIGITS
HPOUT	MOV	A,M		GET CONTENTS OF MEMORY
	INX	H		AND POINT TO NEXT
	PUSH	PSW		SAVE FOR LATER
	RRC			ROTATE
	RRC			UPPER DIGIT
	RRC			INTO
	RRC			LOWER DIGIT
	CALL	POUT		DISPLAY UPPER DIGIT
	POP	PSW		GET LOWER DIGIT BACK
* DISPLAYS ONE DIGIT
POUT	ANI	$0F		REMOVE UPPER GARBAGE
	ORI	$30		CONVERT TO ASCII DIGIT
	STAX	D		SAVE IN EDIT BUFFER
	INX	D		ADVANCE POINTER IN EDIT BUFFER
	JMP	OUT		DISPLAY DIGIT ON TERMINAL AND RETURN
*
******************************************************************
*                   BASIC COMMAND HANDLERS
******************************************************************
*
* IT'S A 'LIST' COMMAND, LETS GIVE HIM A PEEK AT THE SOURCE
* ALSO PLACE LAST LINE LISTED IN BUFFER, INCASE HE WANTS TO EDIT IT
*
LIST	PUSH	D		SAVE PROGRAM POINTER
	LXI	H,TEXT		START AT THE BEGINNING OF THE PROGRAM
	MVI	B,255		SET ENDING LINE BEYOND END OF TEXT
	LDAX	D		GET CHARACTER OF OPERAND
	CALL	NUM		TEST FOR A NUMBER
	JC	GO		IF NOT, LIST WHOLE THING
	CALL	GETLN		GET LINE NUMBER
	PUSH	H		SAVE ON STACK
	INX	D		POINT TO NEXT CHARACTER
	CPI	','		TEST FOR ENDING NUMBER
	CZ	LINEF		IF SO, GET ENDING NUMBER
	INX	H		ADVANCE PAST BEGINNING OF LINE
	POP	D		GET STARTING LINE NUMBER BACK
	PUSH	H		SAVE ENDING LINE
	CALL	LINEF+4		FIND STARTING LINE ADDRESS
	POP	B		GET ENDING ADDRESS BACK
* LIST TEXT FROM STARTING LINE IN H-L TO ENDING LINE IN B-C
GO	MOV	A,M		GET CHARACTER FROM START OF LINE
	INR	A		TEST FOR END OF FILE
	JZ	LIRET		IF SO, STOP LISTING
	CALL	PNUM		DISPLAY LINE NUMBER AND BUFFER IT
	INX	H		SKIP LENGTH BYTE, AS IT DOSN'T LOOK PRETTY
PRINS	MOV	A,M		GET CHARACTER FROM LINE
	STAX	D		PLACE INTO BUFFER
	INX	D		ADVANCE IN BUFFER
	CALL	OUT		DISPLAY ON TERMINAL
	INX	H		ADVANCE POINTER IN PROGRAM
	CPI	$0D		TEST FOR END OF LINE
	JNZ	PRINS		IF NOT, KEEP PRINTING
	CALL	NL		NEW LINE ON TERMINAL
	CALL	COMP		TEST FOR LAST LINE LISTED
	JNC	LIRET		IF SO, STOP LISTING
	CALL	CTRLC		TEST FOR ABORT FROM TERMINAL
	JNZ	GO		KEEP LISTING IF NOT
LIRET	POP	D		RESTORE PROGRAM POINTER
	RET
*
* CLEARS VARIABLES AND ARRAYS. (INITIALIZES THEM) AND INITIALIZES EDIT BUFFER
*
CLEAR	LXI	H,VARS		POINT TO VARIABLE SPACE
	MVI	A,$0D		GET A CARRIAGE RETURN (END OF LINE CHARACTER)
	STA	EDBUF		INITIALIZE EDIT BUFFER TO A NULL LINE
	MVI	C,52		26 VARIABLE TIMES 2 BYTES/VARIABLE
CVLP	MVI	M,0		CLEAR INTEGER VARAIBLES TO ZERO
	INX	H		ADVANCE TO NEXT BYTE OF VARIABLE SPACE
	DCR	C		REDUCE COUNT OF VARAIABLES LEFT
	JNZ	CVLP		KEEP GOING TILL ALL INTEGERS ARE ZERO'ED
	MVI	A,=VARS+$400	ADDRESS OF END OF VARIABLE TABLE
	LXI	B,10		SKIP AHEAD 10 BYTES
	DAD	B		SO THAT WE DON'T CLOBBER OUR FLAGS
CVL1	MVI	M,255		$FF IS NULL CHARACTER FOR CHAR. VARS
	INX	H		POINT TO NEXT BYTE IN CHAR. VAR. SPACE
	CMP	H		TEST FOR COMPLETE (ALL SET TO NULL STRINGS)
	JNZ	CVL1		KEEP GOING TILL WE DO THEM ALL
* INITIALIZE ARRAYS, RESET ARRAY SPACE TO FIRST PAGE FOLLOWING PROGRAM
CLRARY	CALL	GETEOF		GET ADDRESS OF FIRST FREE PAGE+SET POINTER
	STA	ARYLOC		STASH IN ARRAY TABLE POINTER
	MOV	H,A		PLACE IN H, SO WE CAN REFERENCE INDERECT
	MVI	L,52		START AT END OF TABLE
	SHLD	LAST		INDICATE FREE SPACE FOR NEXT ARRAY
	SUB	A		GET A ZERO
CALS	DCR	L		BACK UP IN TABLE
	MOV	M,A		INITIALIZE TO INDICATE NO ARRAY
	JNZ	CALS		KEEP GOING TILL TABLE IS CLEARED
* RESET CONTROL STACK AND DATA POINTER
RESET	LXI	H,CS		GET USER STACK POINTER
	SHLD	CSP		INITIALZE USER STACK POINTER
	LXI	H,0		GET A ZERO (NO DATA POINTER)
	SHLD	DATA		INSURE NO DATA PRESENT
	RET
*
* ** WE'VE GOTTEN A 'RUN' COMMAND, LETS START THE PROGRAM ROLLING **
*
RUN	LDA	TEXT		GET FIRST CHARACTER OF PROGRAM
	LXI	H,NP		AND ADDRESS OF 'NO PROGRAM' MESSAGE
	INR	A		TEST FOR EXISTANCE OF PROGRAM
	JZ	ERR		IF NOT, POINT OUT HIS MISTAKE
	CALL	CLEAR		CLEAR VARIABLES AND ARRAYS
	LXI	D,TEXT		START INTERPRETING AT THE BEGINNING
RGON	MVI	A,255		INDICATE THAT WE ARE RUNNING
	STA	RFLAG		BY SETTING THIS FLAG
RNEWL	INX	D		SKIP PACKED DECIMAL LINE
	INX	D		NUMBERS, AND THE LENGTH BYTE,
	INX	D		AS THE COMMAND FINDER WON'T LIKE IT
* MAIN 'RUN' INTERPRETING LOOP
RLOOP	LXI	SP,STACK	REPAIR ANY DAMAGE
	CALL	CTRLC		TEST FOR 'MAGIC' CONTROL-C CHARACTER
	JZ	STOP		IF SO, FAKE A 'STOP' COMMAND
	LXI	H,PTAB-1	POINT TO PROGRAM COMMAND TABLE
	CALL	CMD		RUN PROGRAM CODE
* ADVANCE TO NEXT STATEMENT
RNEXT	LDAX	D		GET CHARACTER FROM SOURCE
	CPI	$22		TEST FOR A QUOTE
	CZ	SKPQUO		IF SO, SEARCH FOR NEXT ONE
	INX	D		ADVANCE TO NEXT CHARACTER
	CPI	':'		TEST FOR COLON (NEW STATEMENT)
	JZ	RLOOP		IF SO, EXECUTE NEXT COMMAND
	CPI	$0D		TEST FOR CARRIAGE RETURN
	JNZ	RNEXT		IF NOT, KEEP LOOKING
	LDAX	D		GET FIRST CHAR OF NEW LINE
	INR	A		TEST FOR $FF (END OF FILE)
	JZ	INIT		IF SO, GO BACK TO COMMAND MODE
	JMP	RNEWL		EXECUTE THIS LINE
*
* EITHER WE HAVE GOTTEN A 'STOP' COMMAND, OR THE OPERATOR PRESSED
* CONTROL-C, EITHER WAY, PRINT THE MESSAGE AND EXIT
*
STOP	LXI	H,STMSG		ADDRESS OF 'STOP' MESSAGE
	JMP	PERR		TREAT IT LIKE AN ERROR
* IT'S A 'THEN', FOLLOWING AN 'IF', LOOK FOR LINE NUMBER OR A STATEMENT
THEN	CALL	NUM		IS IT A NUMBER?
	JNC	GOTO		IF SO, ITS A NUMBER TO 'GOTO'
	JMP	RLOOP		IF NOT, ITS A STATEMENT TO EXECUTE
*
* IT'S A 'GOSUB' SAVE RETURN ADDRESS, AND PRETEND IT'S 'GOTO'
*
GOSUB	CALL	PUSHD		SAVE SOURCE POSITION
	SUB	A		INDICATE GOSUB ENTRY
	CALL	PUSHS		SAVE ON USER STACK
	LDAX	D		RESTORE OPERAND CHARACTER
*
* IT'S A 'GOTO' MAKE THE BIG JUMP
*
GOTO	CPI	'('		TEST FOR COMPUTED GOTO
	JNZ	NOON		IF NO, NOT AN 'ON' STATEMENT
	CALL	EXPR		GET VALUE OF INTERNAL EXPRESSION
GLPO	CALL	SKIP		SKIP TO NEXT EXPRESSION
	CPI	','		IF THERE IS NO MORE COMMA'S
	JNZ	SYNT		THEN WE RAN OUT OF OPERANDS
GLPD	INX	D		SKIP THE COMMA
	DCR	L		REDUCE OUR COUNT
	JP	GLPO		IF IT'S STILL POSITIVE, KEEP SKIPPING
	LDAX	D		GET CHARACTER FROM SOURCE
	CPI	' '		TEST FOR BLANKS
	JZ	GLPD		AND KEEP GOING TILL WE SKIP THEM
NOON	PUSH	D		SAVE POSITION (IN CASE WE FAIL)
	CALL	FNDLIN		FIND THE LINE HE WANTS
	POP	D		RESTORE OUR POSITION
	XCHG			SWAP NEW POS INTO D-E
	JZ	RGON		IF SUCESS, GOTO NEW LINE
	XCHG			SWAP BACK
*
* OH OH, LOOKS LIKE HE'S TRIED TO GOTO, GOSUB OR ORDER TO A LINE HE FORGOT
* TO TYPE IN, TELL HIM ABOUT IT AND LET HIM TRY TO FIGURE IT OUT
*
BADLIN	LXI	H,LIN		ADDRESS OF 'LINE NUMBER' MESSAGE
	JMP	ERR		HANDLE LIKE ANY ERROR
*
* IT'S A 'RETURN', HOPE SOMEBODY DID A 'GOSUB' SOMEWHERE
*
RETURN	CALL	POPS		GET TYPE OF STACK ENTRY
	ANA	A		TEST FOR 'GOSUB' ENTRY
	JZ	POPD		IF SO, GET ADDRESS BACK AND RETURN
*
* HE SCREWED UP THE FOR/NEXT, GOSUB/RETURN NESTING
* LET HIM IN ON IT AND DIE WHILE WE CAN
*
NSTERR	LXI	H,CSTK		ADDRESS OF 'NESTING' MESSAGE
	JMP	ERR		HANDLE LIKE ANY ERROR
*
* IT'S A 'FOR' COMMAND, LETS THROW THIS THING FOR A LOOP
*
FOR	CALL	VCHAR		INSURE IT'S A VARIABLE
	PUSH	PSW		SAVE IT (IT'S THE LOOP INDEX VARIABLE)
	DCX	D		BACK UP POINT JUST BEFORE EXPRESSION
	MOV	A,E		GET LOW ADDRESS
	STA	P		AND PLACE IN POSITION FLAG
FINTO	LDAX	D		GET CHARACTER FROM SOURCE
	CPI	$0D		TEST FOR END OF LINE
	JZ	SYNT		IF SO, HE'S GOOFED
	INX	D		SKIP TO NEXT
	CPI	'T'		TEST FOR A 'T'
	JNZ	FINTO		IF NOT, WE ARN'T THERE YET
	LDAX	D		GET NEXT CHARACTER
	CPI	'O'		IS IT 'TO'
	JNZ	FINTO		NO, MUST BE VARIABLE 'T'
	PUSH	D		SAVE OUR POSITION
	DCX	D		BACKUP TO THE 'T'
	CALL	DOEXP		EVALUATE EXPRESSION
	POP	D		RESTORE OUT POSITION
	INX	D		SKIP 'O'
	CALL	EXPR		GET LIMIT EXPRESSION
	CALL	PUSHD		SAVE OUR POSITION ON STACK
	XCHG			GET LIMIT VALUE
	CALL	PUSHD		SAVE ON STACK
	XCHG			GET POSITION BACK
	POP	PSW		GET INDEX VARIABLE NAME
*
* SAVES A SINGLE BYTE ENTRY ON THE USER (CONTROL) STACK
*
PUSHS	PUSH	H		SAVE H-L
	LHLD	CSP		GET STACK POINTER
	MOV	M,A		SAVE BYTE ON STACK
PSH1	DCX	H		REDUCE POINTER
PSH2	SHLD	CSP		RESAVE STACK POINTER
	POP	H		RESTORE H-L
	RET
*
* POP A SINGLE BYTE ENTRY FROM THE USER (CONTROL) STACK
*
POPS	PUSH	H		SAVE H-L
	LHLD	CSP		GET STACK POINTER
	INX	H		ADVANCE TO NEXT ENTRY
	MOV	A,M		GET BYTE BACK
	JMP	PSH2		SAVE POINTER AND CONTINUE
*
* PUSHES A DOUBLE BYTE ENTRY ON THE USER (CONTROL) STACK
*
PUSHD	PUSH	H		SAVE H-L
	LHLD	CSP		GET STACK POINTER
	MOV	M,D		SAVE HIGH BYTE
	DCX	H		BACK UP
	MOV	M,E		SAVE LOW BYTE
	JMP	PSH1		SAVE POINTER AND CONTINUE
*
* POPS A DOUBLE BYTE ENTRY FROM THE USER STACK
*
POPD	PUSH	H		SAVE H-L
	LHLD	CSP		GET STACK POINTER
	INX	H		ADVANCE TO LAST ENTRY
	MOV	E,M		GET LOW BYTE
	INX	H		ADVANCE TO HIGH BYTE
	MOV	D,M		GET HIGH BYTE
	JMP	PSH2		SAVE AND CONTINUE
*
* LET COMMAND, EVALUATE EXPRESSION
*
LET	CALL	EXPR		EVALUATE EXPRESSION
	LDA	EFLAG		DID HE MAKE AN ASSIGNMENT?
	ANA	A		IF NOT..
	JZ	SYNT		HE'S MADE ANOTHER MISTAKE
	SUB	A		RESET THE FLAG
	STA	EFLAG		SO WE KNOW WHEN HE SCREW'S UP AGAIN
	RET
*
* IT'S A NEXT COMMAND, TEST INDEX AGAINST LIMIT, AND LOOP IF NEEDED
*
NEXT	CALL	VCHAR		TEST FOR VALID VARIABLE
	MOV	B,A		STASH IN B FOR SAFEKEEPING
	LHLD	CSP		SAVE CONTROL STACK POINTER..
	SHLD	TEMP		IN CASE WE NEED TO LOOP AGAIN
	CALL	POPS		GET VARIABLE NAME FROM STACK
	CMP	B		TEST FOR WHAT HE GAVE US
	JNZ	NSTERR		IF NOT, HE'S SCREWED UP THE NESTING
	CALL	LOOK		GET VARIABLE VALUE
	PUSH	D		SAVE POSITION
	CALL	POPD		GET LIMIT FROM STACK
	MOV	B,D		GET LIMIT
	MOV	C,E		INTO B-C SO WE CAN 'COMP'
	CALL	COMP		TEST IF INDEX >= LIMIT
	JNC	NOMORE		IF SO, DON'T LOOP ANYMORE
	POP	D		GET POSITION BACK
	INX	H		INCREMENT LOOP INDEX
	LDAX	D		GET VARIABLE NAME BACK
	CALL	STOR		SAVE IT AWAY
	CALL	POPD		GET NEW POSITION
	LHLD	TEMP		GET CONTROL-STACK POINTER
	SHLD	CSP		AND REPLACE IT (LEAVING STACK UNCHANGED)
	RET
* WE HAVE HIT THE END OF A FOR NEXT LOOP
NOMORE	CALL	POPD		CLEAN UP CONTROL STACK
	POP	D		GET PROGRAM COUNTER BACK
*
* REMARK, DO NOTHING, BUT RETURN, ALLOWING 'RNEXT' TO SKIP THE COMMAND
*
REM	RET
*
* IT'S AN 'IF' STATEMENT. FIND OUT 'IF' WE DO IT OR NOT
*
IF	DCX	D		BACK UP IN SOURCE
	MOV	A,E		GET LOW ADDRESS
	STA	P		SAVE IN POSITION POINTER
FTHEN	LDAX	D		GET CHARACTER FROM SOURCE
	CPI	$0D		IF IT'S A CARRIAGE RETURN..
	JZ	SYNT		THEN HE DIDN'T TYPE IN A 'THEN'
	INX	D		ADVANCE TO NEXT CHARACTER
	CPI	'T'		IS IT A 'T'?
	JNZ	FTHEN		IF NOT, IT AINT THE START OF 'THEN'
	LDAX	D		GET NEXT CHARACTER
	CPI	'H'		TEST FOR NEXT CHARACTER OF 'THEN'
	JNZ	FTHEN		NO, MUST BE VARIABLE 'T' (OR HE CAN'T SPELL)
	DCX	D		BACK UP TO 'T'
	PUSH	D		SAVE POSITION IN SOURCE
	CALL	DOEXP		EVALUATE CONDITION EXPRESSION
	POP	D		GET POSITION BACK
	MOV	A,H		GET RESULT AND TEST.
	ORA	L		IT FOR ZERO (FALSE)
	RZ			IF SO, SKIP THIS STATEMENT
	JMP	RLOOP		EXECUTE THE 'THEN'
*
* LONG IF, CONTROLS REMAINDER OF ENTIRE LINE
*
LIF	CALL	IF		CALCULATE AND PROCESS IF TRUE
LNXT	INX	D		ADVANCE IN SOURCE
	LDAX	D		GET CHARACTER FROM SOURCE
	CPI	$0D		TEST FOR END OF LINE
	JNZ	LNXT		KEEP LOOKING
	RET
*
* PRINT STATEMENT, LET'S OUTPUT SOMETHING SO HE WON'T GET UPSET
* WHILE STAREING AT THE TUBE WONDERING IF WE DIED
*
PRINT	CALL	EXPR		GET EXPRESSION TO PRINT
	PUSH	D		SAVE BASIC'S PROGRAM COUNTER
	CNC	DECPRT		IF NUMERIC, OUTPUT DECIMAL NUMBER
	POP	D		RESTORE BASIC'S PROGRAM COUNTER
	CC	PV1		IF CHARACTER, DISPLAY CHARACTER VALUE
	LDAX	D		GET CHARACTER FROM SOURCE
	CPI	','		TEST FOR COMMA
	JNZ	NL		IF NOT, IT'S THE END
	CALL	PARSE		ADVANCE TO NEXT NON-BLANK
	JNZ	PRINT		PRINT NEXT EXPRESSION
	RET
* PRINT CHARACTER EXPRESSIONS
PV1	LXI	H,XBF		EXPRESSION IS IN EXTRA BUFFER
PZ	MOV	A,M		GET CHARACTER FROM EXPRESSION
	INX	H		POINT TO NEXT
	ANA	A		TEST FOR END OF EXPRESSION
	RM			IF SO, END IT NOW
	CALL	OUT		PRINT CHARACTER
	JMP	PZ		KEEP GOING TILL END
* RECURSIVE ROUTINE OUTPUTS NUMBER IN DECIMAL
DECPRT	CPI	'('		TEST FOR SPECIAL CASE
	CNZ	SPACE		IF NOT, PRECEDE WITH SPACE
DECP1	LXI	B,10		DIVIDE BY 10
	CALL	DODIV		PERFORM DIVISION
	MVI	A,$30		TO CONVERT TO ASCII
	ADD	L		GET DIGIT
	PUSH	PSW		SAVE FOR OUTPUT
	XCHG			SWAP, REMAINDER IS NOW IN HL
	MOV	A,H		GET HIGH BYTE
	ORA	L		TEST FOR ZERO, (FINISHED)
	CNZ	DECP1		IF NOT, GET NEXT VALUE
	POP	PSW		GET DIGIT OFF STACK
	JMP	OUT		DISPLAY AND RETURN
*
* IT'S AN 'INPUT', LETS GIVE HIM A CHANCE TO DO SOME TYPING.. BUT
* KEEP AN EYE ON HIM, IN CASE HE TRY'S TO PUT SOMETHING OVER ON US
*
INPUT	CALL	CLBF		CLEAR EXTRA TEXT BUFFER
	MVI	A,'?'		GET A QUESTION MARK.
	STA	XBF		TO USE AS THE DEFAULT PROMPT
	LDAX	D		GET FIRST CHAR OF OPERAND
	CPI	$22		TEST FOR USER SUPPLIED PROMPT
	JNZ	INP1		IF NOT, DON'T CHANGE EXISTING ONE
	CALL	EXPR		EVALUATE USER SUPPLIED PROMPT
	CALL	PARSE		SKIP TO NEXT NON-BLANK
INP1	CALL	VCHAR		TEST FOR VALID VARIABLE NAME
	PUSH	D		SAVE SOURCE POSITION
	INX	D		ADVANCE TO NEXT CHARACTER
	PUSH	PSW		SAVE VARIABLE NAME
	LDAX	D		GET NEXT CHARACTER
	CPI	'$'		TEST FOR CHARACTER INPUT
	JZ	GCHR		IF SO, GET CHARACTER DATA
	LXI	H,0		START WITH A ZERO
	DAD	SP		AND GET STACK POINTER. IN CASE WE BLOW UP
	SHLD	TEMP		SAVE SO WE CAN GET IT BACK LATER
RETRY	CALL	PV1		DISPLAY USER PROMPT
	SUB	A		GET A ZERO
	STA	IFLAG		AND CLEAR THE INPUT FLAG (IN CASE HE CTRL-C'S)
	CALL	GLINE		GET A LINE FROM THE TERMINAL
	STA	IFLAG		SET IFLAG. (SO GET ERROR, WE CAN COME BACK)
	CALL	EXPR		EVALUATE EXPRESSION
	POP	PSW		RESTORE VARAIABLE NAME
	CALL	STOR		STASH VALUE IN VARIABLE
	POP	D		RESTORE SOURCE POSITION
	SUB	A		GET A ZERO
	STA	IFLAG		AND CLEAR IFLAG
	RET
* CHARACTER INPUT
GCHR	CALL	PV1		DISPLAY USER PROMPT
	CALL	GLINE		GET A LINE OF INPUT
	POP	PSW		GET VARIABLE BACK
	CALL	LTA		GET THE TEXT VARIABLE'S ADDRESS
	MVI	B,35		LENGTH IS 35
Z1	LDAX	D		GET CHARACTER FROM INPUT BUFFER
	CPI	$0D		TEST FOR END OF BUFFER
	JZ	Z2		IF SO, END THE LINE
	DCR	B		TEST FOR END OF VARIABLE SPACE
	JZ	Z2		IF SO, END THE LINE
	MOV	M,A		SAVE IN VARIABLE SPACE
	INX	H		NEXT CHARACTER IN VARIABLE
	INX	D		NEXT CHARACTER IN INPUT BUFFER
	JMP	Z1		COPY NEXT CHARACTER
Z2	POP	D		RESTORE SOURCE POSITION
Z3	MVI	M,$FF		PAD BUFFER WITH NULL CHARACTERS
	INX	H		NEXT POSITION IN VARIABLE
	DCR	B		REDUCE COUNT TILL END
	JP	Z3		KEEP GOING TILL VARIABLE IS FILLED
	RET
*
* LOOK'S LIKE HE CAN'T EVEN ENTER A SIMPLE NUMBER, CLEAN UP ANY STACK
* HE MAY HAVE USED, AND LET HIM TAKE ANOTHER BLIND STAB AT THE KEYBOARD
*
INERR	LXI	H,IERMS		GET NASTY MESSAGE
	CALL	PMSG		GIVE HIM THE BAD NEWS
	LHLD	TEMP		GET HIS OLD STACK BACK
	SPHL			RESET HIS STACK
	JMP	RETRY		LET HIM TRY AGAIN
*
* DIMENSION, HE WANTS SOME ARRAY SPACE.. I SUPPOSE WE SHOULD GIVE IT TO HIM
*
DIM	MOV	A,E		GET ADDRESS OF OUR POSITION
	STA	P		SAVE IN POSITION POINTER
DIM0	LDAX	D		GET CHARACTER FROM SOURCE
	INX	D		ADVANCE TO NEXT
	CPI	$0D		TEST FOR END OF LINE
	JZ	SYNT		IF SO, TELL HIM TO STRAIGHTEN UP
	CPI	')'		TEST FOR START OF ARRAY DIMENSION
	JNZ	DIM0		IF NOT, KEEP LOOKING
	DCX	D		BACK UP FOR EXPRESSION
	PUSH	D		SAVE BASIC PROGRAM COUNTER
	CALL	DOEXP		EVALUATE ARRAY SIZE
	INX	H		ADD ONE ENTRY (ZERO ENTRY DOES EXIST)
	DAD	H		DOUBLE BECAUSE THEY ARE 16 BIT'S
	DCX	D		BACK UP TO NAME
	MOV	B,H		COPY SIZE NEEDED
	MOV	C,L		INTO B AND C
	LHLD	LAST		GET FREE ADDRESS
	PUSH	H		SAVE FOR TABLE
DLOOP	MVI	M,0		ZERO ARRAY BYTE
	INX	H		ADVANCE TO NEXT
	DCX	B		REDUCE COUNT
	MOV	A,B		GET HIGH BYTE OF REMAINING TO DO
	ORA	C		TEST FOR NONE LEFT
	JNZ	DLOOP		IF NOT, KEEP ZEROING
	SHLD	LAST		SAVE NEXT FREE SPACE INDICATOR
	POP	H		GET ADDRESS OF ARRAY BACK
	LDAX	D		GET ARRAY NAME
	CALL	TABENT		GET TABLE ENTRY
	MOV	A,H		GET HIGH ADDRESS
	STAX	B		PLACE IN TABLE
	INX	B		ADVANCE IN TABLE
	MOV	A,L		GET LOW ADDRESS
	STAX	B		PLACE IN TABLE
	POP	D		GET SOURCE POSITION BACK
	CALL	PARSE		ADVANCE TO NEXT NON-BLANK
	RZ
	CPI	','		TEST FOR ANOTHER OPERAND
	JZ	DIM		IF SO, KEEP GOING
	SUB	A		CAUSE A SYNTAX ERROR BECAUSE WE ARE BAD
*
* LOCATES TABLE POSITION OF AN ARRAY
*
TABENT	CALL	VCHAR		INSURE IT'S OK
	SUI	'A'		CONVERT TO BINARY
	ADD	A		X 2 FOR TWO BYTE ENTRIES
	MOV	C,A		SAVE IN C
	LDA	ARYLOC		GET ARRAY PAGE
	MOV	B,A		SAVE IN HIGH ZBYTE
	RET
* LOOKS UP AN ARRAY VALUE
ALOOK	CALL	DOEXP		CALCULATE INDEX VALUE
	DCX	D		BACK UP PAST '['
	LDAX	D		GET VARIABLE NAME
	CALL	LOOKT		FIND ADDRESS OF ENTRY
	MOV	B,M		GET HIGH BYTE OF ENTRY
	INX	H		ADVANCE TO LOW BYTE
	MOV	C,M		GET LOW BYTE OF ARRAY ENTRY
	MOV	H,B		TRANSFER RESULT TO .
	MOV	L,C		H AND L WHERE THEY ARE EXPECTED
	LDAX	D		GET VARIABLE NAME BACK
	CPI	'@'		TEST FOR MAGIC 'PEEK' ARRAY
	RNZ			IF NOT, WE ARE OK
	MOV	L,H		SET VALUE TO THAT OF FIRST BYTE
	MVI	H,0		AND ELIMINATE HIGH BYTE
	RET
*
* LOCATES ADDRESS OF AN ARRAY ENTRY IN THE ARRAY TABLE. INDEX IN HL
*
LOOKT	CPI	'@'		TEST FOR SPECIAL CASE
	RZ			IF SO, PEEK AT ADDRESS
	CALL	TABENT		LOCATE TABLE ENTRY
	PUSH	D		SAVE BASIC PROGRAM COUNTER
	LDAX	B		GET FIRST BYTE
	MOV	D,A		COPY TO HIGH BYTE
	INX	B		ADVANCE TO NEXT
	LDAX	B		GET LOW BYTE
	MOV	E,A		COPY TO D
	DAD	H		X TWO FOR TWO BYTE ENTRIES
	DAD	D		ADD IN OFFSET FOR START OF ARRAY
	ORA	D		TEST FOR ADDRESS OF ZERO, = NOT DIMENSIONED
	POP	D		RESTORE PROGRAM COUNTER
	RNZ			NOT A DIMENSION ERROR, GO BACK
*
* EITHER HE'S TRIED TO INDEX A NON-ARRAY VARIABLE, TRIED TO INDEX A CHARACTER
* VARIABLE WITH A VALUE GREATER THEN 34, OR HE'S PLOTTED OUTSIDE OF THE SCREEN
* NO MATTER WHAT HE'S DONE, GIVE HIM A NASTY MESSAGE SO HE WON'T DO IT AGAIN
*
DIMERR	LXI	H,OVM		ADDRESS OF NASTY MESSAGE
	JMP	ERR		GIVE IT TO HIM
* LOCATES THE ADDRESS OF A CHARACTER (TEXT) VARIABLE
LTA	SUI	$41		REDUCE TO SIMPLE BINARY
	CPI	26		TEST FOR VALID VARIABLE
	JNC	SYNT		IF NOT, GET MAD
	LXI	H,VARS+25	START OF CHARACTER VARIABLES (-37)
	LXI	B,37		LENGTH OF CHARACTER VARIABLES
V1	DAD	B		OFFSET INTO TABLE
	DCR	A		REDUCE VARIABLES WE HAVE TO GO
	JP	V1		IF NOT FINISHED, KEEP OFFSETING
	RET
*
* IT'S A 'USR' COMMAND, FIND OUT WHAT HE WANT'S, PASS CONTROL  TO
* HIS MACHINE LANGUAGE ROUTINE, AND GOD HELP HIM IF HE SCREW'S UP
* BECAUSE WE CAN'T DO ANYTHING FOR HIM UNTIL HE RETURNS
*
USR	LXI	H,URET		GET ON STACK (SO HE CAN 'RET' TO IT)
	PUSH	H		SAVE IN MACHINE STACK
	CALL	EXPR		EVALUATE ADDRESS
	PUSH	H		SAVE ON STACK (SO WE CAN 'RET' TO IT)
	LDAX	D		GET NEXT CHARACTER
	CPI	','		TEST FOR MORE PARAMETERS
	JNZ	CSAV		IF NOT, DONT EVALUATE
	INX	D		SKIP THE ','
	CALL	EXPR		EVALUATE PARAMETER TO PASS
* WHEN 'PUSHD' RETURNS, IT WILL EFFECT A JUMP TO HIS CODE
CSAV	JMP	PUSHD		SAVE PROGRAM POSITION
* IF WE GET HERE, HE MADE IT BACK IN ONE PIECE
URET	CALL	POPD		GET PROGRAM COUNTER BACK
	LDAX	D		GET CHARACTER FROM SOURCE
	CPI	','		TEST FOR VARIABLE TO RECEIVE H-L
	RNZ			IF NOT, WE ARE DONE
	CALL	PARSE		KEEP LOOKING
*
* STORES H-L INTO A INTEGER VARIABLE PASSED IN A
*
STOR	MVI	B,=VARS		GET ADDRESS OF VARIABLE TABLE
	SUI	$41		CONVERT TO BINARY
	CPI	26		TEST FOR VALID VARIABLE NAME
	JNC	SYNT		IF NOT, IT'S INVALID
	ADD	A		DOUBLE BECAUSE THEY ARE 16 BIT ENTRIES
	MOV	C,A		PLACE IN C, MAKING COMPLETE ADDRESS
	MOV	A,L		GET HIGH VALUE TO SAVE
	STAX	B		SAVE IN VARIABLE
	INX	B		NEXT BYTE OF VARIABLE
	MOV	A,H		GET LOW BYTE
	STAX	B		SAVE IN VARIABLE
	RET
*
* RETERIVES CONTENTS OF A VARIABLE
*
LOOK	MVI	B,=VARS		ADDRESS OF VARIABLES
	SUI	$41		CONVERT NAME TO BINARY
	ADD	A		DOUBLE FOR 16 BIT ENTRIES
	MOV	C,A		MAKE COMPLETE ADDRESS
	LDAX	B		GET HIGH BYTE
	MOV	L,A		PLACE IN H
	INX	B		NEXT BYTE OF VARIABLE
	LDAX	B		GET LOW BYTE
	MOV	H,A		PLACE IN L
	RET
*
* IT'S AN 'ORDER', (HE THINKS HE KNOWS WHERE THERE IS SOME DATA)
*
ORDER	PUSH	D		SAVE OUR SOURCE POSITION
	CALL	FNDLIN		GET ADDRESS OF THE LINE HE WANTS
	POP	D		RESTORE OUR POSITION
	PUSH	D		AND RESAVE OUR POSITION
	JNZ	BADLIN		IF IT DOSN'T EXIST, THEN FORGET IT
	INX	H		SKIP FIRST TWO DIGITS OF LINE NUMBER
	INX	H		SKIP LAST TWO DIGITS OF LINE NUMBER
	INX	H		SKIP LENGTH BYTE
	XCHG			MOVE TO D-E
	CALL	VERDAT		GET STATEMENT FROM LINE
	SHLD	DATA		SAVE DATA POINTER
	POP	D		RESTORE OUR LINE, (SO WE CAN TELL HIM)
	RZ
*
* DATA ERROR... ATTEMPT TO READ FROM A LINE WITHOUT 'DATA' OR
* ATTEMPT TO READ THE WRONG DATA TYPE. LET HIM IN ON IT
*
DERR	LXI	H,DTXT		ADDRESS OF 'DATA' MESSAGE
	JMP	SYNT+3		DISPLAY IT
*
* IT'S A READ. (HE WANTS TO KNOW WHATS IN THAT DATA WE FOUND)
*
READ	CALL	VCHAR		IS IT A VALID VARIABLE
	PUSH	PSW		SAVE VARIABLE NAME
	INX	D		ADVANCE TO NEXT CHARACTER
	LDAX	D		GET NEXT CHARACTER
	CPI	'$'		IS IT A CHARACTER VARIABLE?
	JZ	CDAT		IF SO, LOOK FOR CHARACTER DATA
* NUMERIC DATA, FOR NUMERIC VARIABLE
	CALL	GETDAT		GET NUMERIC DATA
	JC	DERR		IF CHARACTER, IT A DATA TYPE ERROR
	POP	PSW		GET VARIABLE NAME BACK
	CALL	STOR		STASH VALUE IN IT
	JMP	MORDAT		SEE IF HE WANT'S MORE DATA
* CHARACTER DATA, FOR CHARACTER VARIABLE
CDAT	INX	D		SKIP DOLLAR SIGN
	CALL	GETDAT		GET DATA
	JNC	DERR		IF NUMERIC, IT'S BAD
	POP	PSW		GET VARIABLE NAME BACK
	CALL	LTA		FIND IT'S ADDRESS
	LXI	B,XBF		DATA IS IN EXTRA BUFFER
	PUSH	D		SAVE SOURCE POSITION
	MVI	E,35		MOVE 35 CHARACTERS
SL1	LDAX	B		GET CHARACTER FROM BUFFER. (DATA)
	MOV	M,A		STASH IT IN THE VARIABLE
	INX	B		SKIP TO THE NEXT CHARACTER IN THE BUFFER
	INX	H		SKIP TO THE NEXT POSITION IN VARIABLE
	DCR	E		REDUCE COUNT OF HOW MANY TO MOVE
	JNZ	SL1		IF NOT FINISHED, KEEP COPYING
	POP	D		RESTORE SOURCE POSITION
* LOOK FOR MORE VARIABLES (OPERANDS) IN THE 'READ' STATEMENT
MORDAT	CALL	PARSE1		FIND NEXT NON-BLANK
	CPI	','		IF COMMA..
	RNZ			IF NOT, WE HAVE ALL THERE IS
	CALL	PARSE		SKIP COMMA AND FIND VARIABLE NAME
	JMP	READ		GET MORE DATA FOR FOLLOWING VARIABLE
* GETS DATA FROM THE DATA STATEMENTS, POINTED TO BY THE CURRENT READ POINTER
GETDAT	LHLD	DATA		GET DATA POINTER
	MOV	A,H		SEE IF IT IS ZERO.
	ORA	L		WHICH INDICATES THAT IT WASN'T INITIALIZED
	JZ	DERR		IF SO, IT'S A DATA ERROR
	PUSH	D		SAVE SOURCE POSIITION
	XCHG			SWAP DATA POINTER TO D-E
	CALL	EXPR		EVALUATE THE DATA EXPRESSION
	PUSH	PSW		SAVE THE CONDITION FLAGS
ENDAT	LDAX	D		GET NEXT CHARACTER FROM THE SOURCE
	CPI	','		TEST FOR MORE DATA
	JZ	COMA		IF SO, WE ARE OK
	CPI	':'		TEST FOR END OF STATEMENT
	JZ	DAT1		GO TO NEXT DATA STATEMENT
	INX	D		ADVANCE ONE CHARACTER
	CPI	$0D		CARRIAGE RETURN?
	JNZ	ENDAT		KEEP LOOKING IF NOT
* HIT THE END OF A LINE, SKIP TO NEXT DATA STATEMENT
	INX	D		SKIP FIRST TWO DIGITS
	INX	D		SKIP SECOND TWO DIGITS
DAT1	INX	D		SKIP LENGTH (OR ':' IF STMT)
	PUSH	H		SAVE H-L REG
	CALL	VERDAT		CHECK FOR DATA STATEMENT
	XCHG			SWAP POINTER BACK TO D-E
	POP	H		RESTORE REGISTERS
	JZ	GDEND		RETURN, WITH NEW DATA POINTER
	LXI	D,$FFFF		INDICATE NO MORE DATA STATEMENTS
COMA	INX	D		SKIP THE COMMA
GDEND	XCHG			SWAP DATA POINTER BACK TO H-L
	SHLD	DATA		SAVE IN POINTER
	XCHG			SWAP VALUE BACK TO H-L
	POP	PSW		GET FLAGS BACK
	POP	D		GET SOURCE POSITION BACK
	RET
*
* VERIFY THAT COMMAND WAS 'DATA'
*
VERDAT	CALL	PARSE1		SKIP TO COMMAND
	XCHG			SWAP TO H-L
	LXI	D,DATCMD	POINT TO DATA COMMAND
VER1	MOV	A,E		GET LOW ADDRESS
	CPI	DATCMD+4	ARE WE AT END
	RZ
	LDAX	D		GET CHR FROM TABLE
	INX	D		ADVANCE TO NEXT
	ANI	$7F		INSURE IT'S CORRECT
	CMP	M		DUZ IT MATCH?
	INX	H		NEXT IN DATA COMMAND
	JZ	VER1		OK, TEST NEXT
	RET
*
* HE WANT'S TO KNOW HOW BIG IT IS... LETS FIGURE IT OUT AND LET HIM IN ON IT
*
SIZE	PUSH	D		SAVE PROGRAM POINTER
	CALL	GETEOF		FIND THE END OF THE FILE
	LXI	B,0-TEXT	GET THE (NEGATIVE) FILE START ADDRESS
	DAD	B		SUBTRACT FILE START FROM FILE END
	CALL	DECPRT		DISPLAY VALUE IN DECIMAL
	LXI	H,SIMSG		GET ' BYTES' MESSAGE
	POP	D		RESTORE PROGRAM POINTER
	JMP	PMSG		TELL HIM WHAT IT IS
* FINDS THE END OF THE FILE, HL=LAST BYTE OF PGM., A=FIRST FREE PAGE
GETEOF	LXI	H,TEXT		START AT THE BEGINING
	MVI	A,255		LOOKING FOR AN FF
GLPX	CMP	M		IS THIS IT?
	INX	H		ADVANCE TO NEXT
	JNZ	GLPX		IF NOT IT, KEEP LOOKING
	DCX	H		POINT BACK TO $FF
	MOV	A,H		GET HIGH VALUE
	INR	A		ADVANCE TO NEXT PAGE
	RET
*
* HE'S TRYING TO 'LOAD' SOMETHING, I WONDER IF HE HAS SOMETHING SAVED..
*
LOAD	CALL	GETNAME		Get filename
	LXI	H,TEXT		Point to area
	OUT	53		Load the file
	JMP	RESV		Clear variables
*
* HE'S TRYING TO 'SAVE' SOMETHING..
*
SAVE	CALL	GETNAME		Get filename
	CALL	GETEOF		HL = EOF
	LXI	D,512-TEXT	DE = adjust for origin/partial/EOF
	DAD	D		HL = adjusted size
	MOV	A,H		Get X256
	RRC	A		A = size in blocks
	ANI	$7F		Remove carry
	MOV	C,A		Set low
	MVI	B,0		Set high
	LXI	H,TEXT		Point to memory
	OUT	54		Write the file
	RET
GETNAME	PUSH	D		Save name pointer
getn1	LDAX	D		Get char from name
	CPI	$0D		End?
	JZ	getn3		Add extension
	INX	D		Skip to next
	CPI	'.'		Dot
	JNZ	getn1		Keep looking
getn2	POP	D		Y = pattern
	OUT	9		Get filename
	ANA	A		Error
	JNZ	inres		error reset
	RET
getn3	XCHG			HL = line
	MVI	M,'.'		Add '.'
	INX	H
	MVI	M,'B'		Add 'B'
	INX	H
	MVI	M,'A'		Add 'A'
	INX	H
	MVI	M,'S'		Add 'S'
	INX	H
	MVI	M,$0D		End line
	JMP	getn2		And process
*
*****************************************************************
*                 EXPRESSION EVALUATION CODE
*****************************************************************
*
* EVALUATES 16 BIT DECIMAL NUMBERS
*
EVAL	LXI	B,1		MULTIPLIER IS ONE
	MOV	H,B		INITIALIZE
	MOV	L,B		STARTING RESULT TO ZERO
ETOP	LDAX	D		GET DIGIT FROM SOURCE
	CALL	NUM		TEST FOR INVALID DIGIT
	RC			IF SO, WE ARE FINISHED
	ANI	$0F		CONVERT TO BINARY
* ADD DIGIT TIMES MULTIPLIER IN B-C TO H-L
ZLOOP	DCR	A		REDUCE BY ONE
	JM	ESP1		EXIT WHEN EXAUSTED
	DAD	B		ADD MULTIPLIER
	JMP	ZLOOP		CONTINUE TILL DONE
* MULTIPLY MULTIPLIER (BC) BY 10
ESP1	PUSH	H		SAVE H-L
	MOV	H,B		GET B-C INTO
	MOV	L,C		H-L SO WE CAN USE 'DAD'
	DAD	B		BC=BC*2
	DAD	H		BC=BC*4
	DAD	B		BC=BC*5
	DAD	H		BC=BC*10
	MOV	B,H		SAVE BACK INTO
	MOV	C,L		B-C REGISTER PAIR
	POP	H		RESTORE H-L
	DCX	D		REDUCE POINTER IN SOURCE
	JMP	ETOP		EVALUATE NEXT CHARACTER
*
* SUBROUTINE TESTS FOR VALID ASCII CHARACTERS
*
CHAR	CPI	'A'		TEST FOR < 'A'
	RC			RETURN SAYING IT'S BAD
	CPI	'['		TEST FOR >'Z'
	CMC			INVERT LOGIC
	RET
*
* PARSES FORWARD, SEARCHING FOR FIRST NON-BLANK CHARACTER
*
PARSE	INX	D		ADVANCE IN SOURCE
PARSE1	LDAX	D		GET CHARACTER FROM SOURCE
	CPI	' '		TEST FOR SPACE
	JZ	PARSE		KEEP LOOKING
	CPI	':'		TEST FOR END OF STATEMENT
	RZ			IF SO, RETURN WITH Z SET
	CPI	$0D		TEST FOR END OF LINE
	RET
*
* SKIPS TO NEXT EXPRESSION OR COMMAND
*
SKIP	CALL	PARSE1		ADVANCE TO NEXT NON-BLANK
	DCX	D		BACK UP TO POSITION
	MOV	A,E		GET LOW ORDER ADDRESS
	STA	P		SAVE IN POSITION BYTE
* LOOK FOR DELIMITER
SKIP1	INX	D		ADVANCE TO NEXT
	LDAX	D		GET CHARACTER
	CPI	':'		TEST FOR DELIMITER
	RZ			IF SO, RETURN
	CPI	','		TEST FOR DELIMITER
	RZ			IF SO, RETURN
	CPI	$0D		TEST FOR DELIMITER
	RZ			IF SO, RETURN
	CPI	$22		TEST FOR QUOTE
	CZ	SKPQUO		IF SO, ADVANCE TO NEXT QUOTE
	JMP	SKIP1		KEEP LOOKING
* FIND NEXT QUOTE IN SOURCE
SKPQUO	INX	D		ADVANCE TO NEXT CHARACTER IN SOURCE
	LDAX	D		GET THE CHARACTER
	CPI	$22		IS IT A QUOTE?
	RZ			IF SO, WE FOUND IT
	CPI	$0D		IF IT A CARRIAGE RETUEN
	JNZ	SKPQUO		IF NOT, OK
	JMP	SYNT		UNMATCHED QUOTES WHILE PARSING
*
* EVALUATES AN EXPRESSION POINTED TO BY D-E. RETURN WITH CARRY SET
* INDICATES THAT EXPRESSION WAS A CHARACTER EXPRESSION
*
EXPR	CALL	SKIP		ADVANCE TO END OF EXPRESSION
	PUSH	D		SAVE POINTER TO END
	CALL	DOEXP		EVALUATE
	POP	D		RESTORE POINTER TO END OF EXPRESSION
	RET
* CALCULATES EXPRESSION BACKWARDS (LIKE APL)
DOEXP	DCX	D		BACK UP IN SOURCE
	CALL	FE		GET CHARACTER FROM SOURCE
	CPI	'$'		TEST FOR CHARACTER VARIABLE
	JZ	CEXP		IF SO, ITS A CHARACTER EXPRESSION
	CPI	$22		TEST FOR QUOTE
	JZ	CEXP		IF SO, IT'S A CHARACTER EXRESSION
	INX	D		ADVANCE
	MVI	A,';'		NULL OPERATOR TO START
EGO1	PUSH	H		SAVE OLD VALUE
	PUSH	PSW		SAVE OPERATOR
	DCX	D		BACK UP TO VALUE
	CALL	FE		GET CHARACTER FROM SOURCE
	CPI	')'		TEST FOR BRACKET
	JZ	BRKTS		IF SO, RECURSE
	CPI	']'		TEST FOR ARRAY LOOKUP
	JZ	ARYL		IF SO, LOOK UP ARRAY VALUE
	CALL	CHAR		TEST FOR VARAIABLE
	JNC	LOOKU		IF SO, LOOK IT UP
	CPI	'?'		TEST FOR RANDOM NUMBER RETERIVAL
	JZ	RANDR		GET RANDOM VALUE
	CPI	'#'		TEST FOR HEX CONSTANT
	JZ	HEXVL		IF SO, GET HEV VALUE
	CALL	NUM		TEST FOR A NUMBER
	JC	SYNT		IF NOT, I DON'T KNOW WHAT HE'S DOING
* DECIMAL NUMBER
CALN	CALL	EVAL		EVALUATE DECIMAL NUMBER
	JMP	OLOOK		LOOK FOR OPERATOR
* HEX. NUMBER
HEXVL	DCX	D		BACK UP IN SOURCE
	LDA	P		GET ENDING POSITION
	CMP	E		TEST FOR PASSED THE LIMIT
	JZ	HEXGO		IF SO, THATS IT
	LDAX	D		GET CHARACTER FROM SOURCE
	CALL	NUM		TEST FOR VALID DIGIT
	JNC	HEXVL		KEEP GOING TILL WE GET TO START OF STRING
	SUI	'A'		TEST FOR VALID LETTER
	CPI	6		OF 'A' TO 'F'
	JC	HEXVL		IF SO, KEEP LOOKING
HEXGO	LXI	H,0		START WITH A ZERO
	MOV	B,H		FLAG TO SEE IF ANY DIGITS
	PUSH	D		SAVE POSITION IN SOURCE
GETHX	INX	D		ADVANCE TO NEXT DIGIT OF HEX NUMBER
	LDAX	D		GET DIGIT
	CPI	'#'		TEST FOR END OF STRING
	JZ	HGON		IF SO, WE ARE DONE
	MOV	B,A		SET FLAG SO WE KNOW WE GOT AT LEAST ONE DIGIT
	DAD	H		SHIFT H-L
	DAD	H		RIGHT IN ORDER
	DAD	H		TO MAKE ROOM FOR
	DAD	H		THE NEW DIGIT
	SUI	'0'		REDUCE TO BINARY
	CPI	10		TEST FOR FURTHER REDUCTION NEEDED
	JC	HISG		IF NOT, PROCESS
	SUI	7		CONVERT LETTER TO BINARY
HISG	ORA	L		ADD IN BOTTOM DIGIT OF RESULT
	MOV	L,A		REPLACE IN RESULT
	JMP	GETHX		GET NEXT DIGIT
HGON	POP	D		GET POSITION IN SOURCE BACK
	MOV	A,B		GET FLAG
	ANA	A		TEST FOR DIGIT'S PROCESSED
	JNZ	OLOOK		NO PROBLEM
	JMP	SYNT		'#' WITH NO DIGITS... ERROR
* A ')' HAS BEEN DETECTED
BRKTS	CALL	DOEXP		RECURSE ON OURSELVES
	JMP	DCLB		CONTINUE WITH VALUE
* LOOK UP AN ARRAY VALUE
ARYL	POP	PSW		GET OPERATOR BACK
	PUSH	PSW		STASH OPERATOR
	CPI	'='		TEST FOR ASSIGNMENT
	CNZ	ALOOK		IF NOT, GET VALUE
	JMP	DCLB		CONTINUE WITH VALUE
* GET VARIABLE CONTENTS
LOOKU	CALL	LOOK		LOOK UP VALUE OF VARIABLE
DCLB	DCX	D		BACK UP IN SOURCE
OLOOK	POP	PSW		GET OPERATOR BACK
	POP	B		GET OLD VALUE BACK
* 16 BIT ADDITION
	CPI	'+'		TEST FOR ADDITION
	JZ	ADD		IF SO, PERFORM ADD
* SIXTEEN BIT SUBTRACTION
	CPI	'-'		TEST FOR SUBTRACTION
	JNZ	MULT		NO, TRY MULTIPLICATION
	MOV	A,B		GET B
	CMA			COMPLEMENT
	MOV	B,A		RESAVE
	MOV	A,C		GET C
	CMA			COMPLEMENT
	MOV	C,A		RESAVE
	INX	B		ADD 1 GIVING TWO'S COMPLEMENT
ADD	DAD	B		ADD TO NEW VALUE
	JMP	EGO		CONTINUE
* 16 BIT MULTIPLICATION
MULT	CPI	'*'		TEST FOR MULTIPLY
	JNZ	DIV		NO, TRY DIVIDE
	MOV	A,B		TEST OLD VALUE FOR ZERO
	ORA	C		AS IT IS A
	JZ	EGZ		SPECIAL CASE
	CALL	DMULT		PERFORM THE MULTIPLY
	JMP	EGO		AND CONTINUE
* MULTIPLY SUBROUTINE (ALSO USED BY RANDOM NUMBER GENERATOR)
DMULT	PUSH	D		SAVE POSITION IN SOURCE
	LXI	D,0		START OUT WITH A ZERO
MUL1	ANA	A		INSURE CARRY CLEAR
	MOV	A,B		GET B
	RAR			ROTATE
	MOV	B,A		RESAVE
	MOV	A,C		GET C
	RAR			ROTATE WITH CARRY
	MOV	C,A		REPLACE
	PUSH	PSW		SAVE FLAGS
	ORA	B		TEST FOR B-C = ZER0
	JZ	MEXIT		IF SO, WE ARE DONE
	POP	PSW		GET FLAGS BACK
	JNC	NOMAD		NO ONE BIT, DON'T ADD
	XCHG			SWAP SO WE CAN
	DAD	D		ADD TO D-E
	XCHG			AND SWAP BACK
NOMAD	DAD	H		SHIFT H-L RIGHT BY ONE BIT
	JMP	MUL1		KEEP GOING
MEXIT	DAD	D		ADD RESULT
	POP	PSW		CLEAN UP STACK
	POP	D		RESTORE SOURCE POSITION
	RET
* 16 BIT DIVISION
DIV	CPI	'%'		TEST FOR DIVIDE
	JNZ	FLOR		NO, TRY FLOR
	MOV	A,B		TEST FOR AN OLD
	ORA	C		VALUE OF ZERO,
	JZ	DIVZE		BECAUSE THAT IS  A BAD THING
	PUSH	D		SAVE SOURCE POSITION
	CALL	DODIV		PERFORM DIVIDE OPERATION
	SHLD	VARS+34		SET 'R' REMAINDER VARIABLE
	XCHG			PLACE RESULT IN H-L
	POP	D		RESTORE SOURCE POSITION
	JMP	EGO		AND CARRY ON
*
* PERFORMS 16 BIT(HL) BY 16 BIT(BC) DIVIDE, RESULT IN DE, REM IN HL
*
DODIV	MOV	A,B		GET CONTENTS OV B
	CMA			INVERT
	MOV	B,A		REPLECE
	MOV	A,C		GET CONTENTS IN C
	CMA			INVERT
	MOV	C,A		REPLACE
	INX	B		COMPLETE TWO COMPLEMENT OPERATION
	XCHG			COPY HL TO DE, LOWER HALF OF 32 BIT VALUE
	LXI	H,0		ZERO HIGHER HALF
	CALL	DIVBYT		PERFORM FIRST HALF
DIVBYT	MOV	A,D		GET UPPER HALF
	MOV	D,E		SAVE LOWER HALF
	MVI	E,8		GET LOOP COUNT
DIVTOP	DAD	H		SHIFT LEFT
	JC	OVER1		OVERFLOWED
	ADD	A		SHIFT  RESULT
	JNC	SUBB		IF NO CARRY, DON'T INC
	INX	H		ADVANCE UPPER VALUE
SUBB	PUSH	H		SAVE VALUE
	DAD	B		SUBTRACT LOWER HALF OF FRACTION
	JC	OKKK		IF WRAP PAST ZERO
	POP	H		RESTORE VALUE
	JMP	NXLP		FINISH LOOP
OKKK	INX	SP		FIX UP
	INX	SP		STACK
	INR	A		ADVANCE RESULT
	JMP	NXLP		FINISH LOOP
OVER1	ADC	A		SHIFT RESULT, +1 FOR CARRY
	JNC	OVRSUB		IF NO WRAP
	INX	H		INC. VALUE
OVRSUB	DAD	B		SUBTRACT LOWER
NXLP	DCR	E		REDUCE LOOP COUNTER
	JNZ	DIVTOP		LOOP IF NOT FINISHED
	MOV	E,A		LOWER BYTE OF RESULT
	RET
*
* HE SHOULD KNOW THAT HE CAN'T DIVIDE BY ZERO, BUT JUST IN CASE...
* WE WILL TELL HIM ANYWAY
*
DIVZE	LXI	H,DER		ADDRESS OF 'DIVIDE BYE ZERO MESSAGE'
	JMP	ERR		HANDLE LIKE ANY OTHER ERROR
* COMPARES H-L TO B-C, Z=1 IF HL=BC, C=1 IF HL<BC
COMP	MOV	A,H		GET HIGH BYTE OF HL
	CMP	B		COMPARE WITH HIGH BYTE OF BC
	RNZ			IF NOT SAME, LOWER BYTE CAN BE IGNORED
	MOV	A,L		GET LOW BYTE OF HL
	CMP	C		COMPARE WITH LOW BYTE OF BC
	RET
* FLOOR, RETURNS THE LESSER OF THE TWO NUMBERS
FLOR	CPI	'\'		IS IT FLOOR?
	JNZ	CEIL		NO, TRY CEILING
	CALL	COMP		COMPARE NEW TO OLD
	JC	EGO		IF LESS, WE ARE OK (RESULT IS ALREADY IN HL)
SWAP	MOV	H,B		MAKE OLD NUMBER..
	MOV	L,C		INTO THE NEW NUMBER..
	JMP	EGO		CONTINUE
* CEILING, RETURNS THE GREATER OF THE TWO NUMBERS
CEIL	CPI	'/'		IS IT CEILING?
	JNZ	LAND		NO, TRY LOGICAL AND
	CALL	COMP		COMPARE NEW AND OLD
	JNC	EGO		IF GREATER, WE ARE OK (RESULT ALREADY IN HL)
	JMP	SWAP		MAKE OLD NEW AND CONTINUE
* LOGICAL AND
LAND	CPI	'&'		IF IT LOGICAL AND ?
	JNZ	LOR		NO, TRY LOGICAL OR
	MOV	A,B		GET HIGH BYTE OF OLD
	ANA	H		AND WITH HIGH BYTE OF NEW
	MOV	H,A		AND REPLACE HIGH BYTE OF NEW
	MOV	A,L		GET LOW BYTE OF OLD
	ANA	C		AND WITH LOW BYTE OF NEW
	JMP	CPYL		CONTINUE
* LOGICAL OR
LOR	CPI	'|'		TEST FOR LOGICAL OR
	JNZ	GRTR		NO, TRY GREATER THAN
	MOV	A,H		GET HIGH BYTE OF NEW
	ORA	B		OR WITH HIGH BYTE OF OLD
	MOV	H,A		AND REPLACE HIGH BYTE OF NEW
	MOV	A,L		GET LOW BYTE OF NEW
	ORA	C		OR WITH LOW BYTE OF OLD
CPYL	MOV	L,A		AND REPLACE LOW BYTE OF NEW
	JMP	EGO		CONTINUE
* GREATER THAN, RETURNS ONE OR ZERO
GRTR	CPI	'>'		TEST FOR GREATER THAN
	JNZ	LETH		IF NOT, TRY LESS THAN
	CALL	COMP		COMPARE OLD AND NEW
	JZ	EGZ		FALSE IF EQUAL
	JC	EGZ		FALSE IF LESS THAN
	JMP	EG1		TRUE IF NOT LESS OR EQUAL
* LESS THAN, RETURNS ONE OR ZERO
LETH	CPI	'<'		IS IT LESS THAN?
	JNZ	ENOP		NO, TRY NO-OP OPERATOR
	CALL	COMP		COMPARE OLD AND NEW
	JC	EG1		TRUE IF LESS
	JMP	EGZ		FALSE IF NOT LESS
* NO-OP OPERATOR, RETURNS NEW VALUE ONLY
ENOP	CPI	';'		IS IT NO-OP?
	JZ	EGO		IF SO, DON'T DO ANYTHING
* ASSIGNMENT, SET A VARIABLE'S VALUE
ASST	CPI	'='		TEST FOR ASSIGNMENT
	JNZ	EQUAL		IF NOT, TRY EQUALITY
	STA	EFLAG		SET ASSIGNMENT FLAG
	INX	D		BACK UP TO VARIABLE NAME
	LDAX	D		GET VARIABLE CHARACTER
	CPI	']'		TEST FOR ARRAY STORAGE
	JZ	ASTOR		IF SO, STORE INTO ARRAY
	MOV	H,B		GET OLD VALUE
	MOV	L,C		INTO H-L (WHERE STORE WANTS THEM)
	CPI	'?'		TEST FOR SETTING RANDOM SEED
	JZ	SRSEED		IF SO, SET THE SEED
	CALL	STOR		STORE VALUE INTO VARIABLE
STRT	DCX	D		STEP BACK FROM VARIABLE
	JMP	EGO		AND CONTINUE
* SET THE RANDOM SEED
SRSEED	SHLD	SEED		SO WE CAN STORE IN SEED
	JMP	STRT		AND CONTINUE
* SET THE VALUE OF AN ARRAY ELEMENT
ASTOR	PUSH	H		SAVE H-L
	CALL	DOEXP		CALCULATE INDEX VALUE
	DCX	D		BACK UP PAST '['
	LDAX	D		GET ARRAY NAME
	CALL	LOOKT		LOOK UP IT'S ADDRESS IN THE TABLE
	MOV	B,H		GET ARRAY ADDRESS
	MOV	C,L		INTO B-C
	POP	H		RERSTORE H-L
	LDAX	D		GET ARRAY NAME BACK
	CPI	'@'		TEST FOR 'MAGIC', MEMORY REFERENCE
	JZ	STMEM		IF SO, SET MEMORY LOCATION
	MOV	A,H		GET HIGH BYTE OF VALUE
	STAX	B		STASH IN ARRAY
	INX	B		POINT TO NEXT
STMEM	MOV	A,L		GET LOW BYTE OF VALUE
	STAX	B		STASH IN ARRAY
	JMP	STRT		CONTINUE
* TEST FOR EQUALITY.  ('==')
EQUAL	SUI	$81		IS A '=='?
	JNZ	GEQL		IF NOT, TRY GREATER OR EQUAL
	CALL	COMP		COMPARE OLD AND NEW
	JZ	EG1		TRUE IF EQUAL
	JMP	EGZ		FALSE IF NOT EQUAL
* GREATER OR EQUAL.  ('>=')
GEQL	DCR	A		TEST FOR '>='?
	JNZ	LEQL		NO, TRY LESS OR EQUAL
	CALL	COMP		COMPARE OLD AND NEW
	JC	EGZ		FALSE IF LESS THAN
	JMP	EG1		TRUE IF GREATER OR EQUAL
* LESS OR EQUAL.  ('<=')
LEQL	DCR	A		TEST FOR '<='?
	JNZ	NEQL		IF NOT, TRY NOT EQUAL
	CALL	COMP		COMPARE OLD AND NEW
	JZ	EG1		TRUE IF SAME
	JC	EG1		TRUE IF LESS THAN
	JMP	EGZ		FALSE OTHERWISE
* TEST FOR NOT EQUAL.  ('-=')
NEQL	DCR	A		IS IT '-='?
	JNZ	SYNT		BEATS ME WHAT IT IS!
	CALL	COMP		COMPARE OLD AND NEW
	JZ	EGZ		IF SAME, FALSE
* RETURN RESULT OF ONE
EG1	LXI	H,1		SET RESULT TO ONE
	JMP	EGO		PASS ON RESULT
* RETURN RESULT OF ZERO
EGZ	LXI	H,0		SET RESULT TO ZERO
* END OF OPERATION, GET NEXT OPERATOR
EGO	CALL	FE		GET NEXT CHARACTER
	RZ			IF WE PASS BEGINNING OF EXPRESSION, QUIT
	CPI	'('		ARE WE RETURNING FROM A NEST?
	RZ			IF SO, BACK UP ONE LEVEL
	CPI	'['		FINISHED AN ARRAY INDEX EVALUATION?
	RZ			RETURN TO MAIN EXPRESSION
	CPI	'='		IF IT A MULTI-CHARACTER OPERATOR
	JNZ	EGO1		IF NOT, DON'T PRE-EVALUATE
	DCX	D		BACK UP TO PRECEDING CHARACTER
	LDAX	D		GET PRECEDING CHARACTER
	CPI	'='		IS IT '=='?
	MVI	B,$81		SET UNIQUE CODE
	JZ	EGO2		IF '==' THEN WE HAVE IT
	INR	B		NEXT UNIQUE CODE
	CPI	'>'		IS IT '>='?
	JZ	EGO2		IF SO, WE HAVE IT
	INR	B		NEXT UNIQUE CODE
	CPI	'<'		IS IT '<='?
	JZ	EGO2		IF SO, WE HAVE IT
	INR	B		NEXT UNIQUE CODE
	CPI	'-'		IS IT '-='?
	JZ	EGO2		IF SO, WE HAVE IT
	INX	D		WASN'T A TWO CHARACTER OPERATOR. BACK UP
	MVI	A,'='		MUST HAVE BEEN A SIMPLE '='
	JMP	EGO1		CONTINUE EVALUATING EXPRESSION
EGO2	MOV	A,B		SET OPERATOR TO OUR UNIQUE CODE
	JMP	EGO1		AND CONTINUE EVALUATING EXPRESSION
* FINDS NEXT CHARACTER IN EXPRESSION, SETS Z FLAG IF WE PASS THE BEGINNING
FE	LDA	P		GET ADDRESS OF BEGINNING OF LINE
	CMP	E		ARE WE THERE??
	RZ			IF SO, WE ARE FINISHED
	LDAX	D		GET CHARACTER FROM SOURCE
	CPI	' '		IS A (USELESS) BLANK?
	RNZ			IF NOT, WE ARE FINISHED
	DCX	D		BACK UP ANOTHER CHARACTER
	JMP	FE		AND TRY AGAIN
* CALCULATE A PSEUDO-RANDOM VALUE
RANDR	LHLD	SEED		GET RANDOM SEED
	MOV	A,H		GET HIGH BYTE OF SEED
	ANI	$F7		AND WITH HIGH MASK
	PUSH	PSW		SAVE PARITY FLAG
	MOV	A,L		GET LOW BYTE OF SEED
	ANI	$42		AND WITH LOW BYTE OF MASK
	PUSH	PSW		SAVE PARITY FLAG
	POP	B		GET FLAGS IN C
	MOV	A,C		COPY TO A
	POP	B		GET FIRST SET OF FLAGS IN C
	XRA	C		COMPUTE PARITY FOR ENTIRE WORD
	RRC			MOVE COMPUTED
	RRC			PARITY INTO
	RRC			THE CARRY FLAG
	CMC			COMP, SO SHIFT IN 1 IF EVEN
	MOV	A,L		GET LOW BYTE OF SEED
	RAL			SHIFT IN CARRY, OUT HIGH BIT
	MOV	L,A		RESAVE
	MOV	A,H		GET HIGH BYTE OF SEED
	RAL			SHIFT IN CARRY (HIGH BIT OF OLD LOWER)
	MOV	H,A		RESAVE
	SHLD	SEED		RESULT IS NEW SEED
	JMP	DCLB		KEEP GOING
*
* EVALUATES A CHARACTER EXPRESSION
*
CEXP	CALL	CLBF		CLEAR EXTRA BUFFER
	INX	D		SKIP TO END OF EXPRESSION
	MVI	A,'+'		TO BEGIN, CONCATINATE A NULL STRING
CG1	PUSH	PSW		STACK THE OPERATOR FOR LATER
	CALL	PUSHB		COPY NEW BUFFER INTO OLD BUFFER
	CALL	CLBF		CLEAR THE NEW BUFFER
	DCX	D		BACK UP IN SOURCE
	CALL	FE		GET CHARACTER AND TEST FOR END
	CPI	$22		TEST FOR QUOTE
	JZ	CQ		IF SO, HANDLE QUOTED STRING
	CPI	'$'		TEST FOR CHARACTER VARIABLE
	JNZ	SYNT		IF NOT, IT'S NOT ANYTHING I RECOGNISE
CV	DCX	D		BACK UP PAST DOLLAR SIGN
	LDAX	D		GET VARIABLE NAME
	CPI	']'		TEST FOR INDEX INTO CHARACTER VARIABLE
	JZ	CINDX		GET INDEX VALUE
	CALL	LTA		GET ADDRESS OF VARIABLE
	PUSH	D		SAVE SOURCE POSITION
	XCHG			SWAP ADDRESS TO D-E
	DCX	D		BACK UP IN SOURCE
	JMP	Q0		SAVE VARIABLE IN NEW BUFFER
* BACKUP TO PRECEDING QUOTE
CQ	DCX	D		BACKUP IN SOURCE
	LDAX	D		GET CHARACTER FROM SOURCE
	CPI	$0D		TEST FOR END OF LINE
	JZ	SYNT		IF SO, THERE IS NO CLOSEING QUOTE
	CPI	$22		TEST FOR CLOSEING QUOTE
	JNZ	CQ		IF NO, KEEP LOOKING
	PUSH	D		SAVE ENDING POSITION
Q0	LXI	H,XBF		GET ADDRESS OF NEW (EXTRA) BUFFER
Q1	INX	D		ADVANCE TO SOURCE OR VARIABLE CHARACTER
	LDAX	D		GET CHARACTER
	CPI	$22		TEST FOR CLOSEING QUOTE
	JZ	Q2		IF SO, STOP COPYING
	CPI	$FF		TEST FOR END OF VARIABLE
	JZ	Q2		IF SO, STOP COPYING
	MOV	M,A		SAVE IN BUFFER
	INX	H		ADVANCE IN BUFFER
	JMP	Q1		KEEP COPYING
Q2	POP	D		GET POSITION BACK
Q3	DCX	D		BACK UP TO OPERATOR
	POP	PSW		GET OPERATOR
	CPI	'+'		TEST FOR CONCATIONATION
	JNZ	Q5		NO, TRY ASSIGNMENT
* CONCATONATION. XBF=XBF+TB
QPP	LXI	B,TB		ADDRESS OF TEMPORARY BUFFER
Q4	LDAX	B		GET CHARACTER FROM BUFFER
	MOV	M,A		MOVE TO BUFFER
	INX	B		ADVANCE IN OLD
	INX	H		ADVANCE IN NEW
	MOV	A,C		GET ADDRESS IN OLD
	CPI	TB+35		TEST FOR OVER
	JC	Q4		IF SO, STOP
	LHLD	XBF		GET CHARACTER FROM BUFFER
	MVI	H,0		SET HIGH BYTE TO ZERO
	JMP	Q9		CONTINUE
* ASSIGNMENT
Q5	CPI	'='		TEST FOR ASSIGNMENT
	JNZ	Q6		IF NOT, TRY EQUALITY
	INX	D		SKIP TO VARIABLE NAME
	INX	D		SKIP TO DOLLARSIGN
	LDAX	D		GET DOLLARSIGN
	DCX	D		BACK UP TO VARIABLE NAME
	CPI	'$'		TEST FOR DOLLAR SIGN
	JNZ	SYNT		IF NOT, THIS AIN'T NO CHARACTER VARIABLE
	STA	EFLAG		SET ASSIGNMENT FLAG
	LDAX	D		GET VARIABLE NAME
	DCX	D		BACK UP BAST NAME
	CALL	LTA		GET IT'S ADDRESS
	JMP	QPP		COPY IT OVER
* TEST FOR EQUALITY
Q6	CPI	$81		TEST FOR '=='
	JNZ	X0		NO, TRY '=-'
	CALL	COMSTR		COMPARE STRINGS
	JMP	Q9		CONTINUE
* COMPARES STRINGS. SETS H-L TO 1 OR 0 IF EQUAL OR NOT EQUAL
COMSTR	LXI	B,TB		GET ADDRESS OF OLD STRING
	LXI	H,XBF		ADDRESS OF NEW STRING
Q7	LDAX	B		GET CHARACTER FROM OLD
	CMP	M		TEST AGAINST NEW
	JNZ	Q8		IF NOT, THEY ARE UNEQUAL
	INX	B		NEXT PLACE IN OLD
	INX	H		NEXT PLACE IN NEW
	INR	A		TEST FOR END OF STRING
	JNZ	Q7		IF NOT, CONTINUE TESTING
	LXI	H,1		INDICATE THEY ARE EQUAL
	RET
Q8	LXI	H,0		INDICATE NOT EQUAL
	RET
* NOT EQUAL .. '-='
X0	CPI	$82		TEST FOR '-='
	JNZ	SYNT		BEATS ME, BUT IT ISN'T RIGHT
	CALL	COMSTR		TEST STRINGS
	MOV	A,L		GET RESULT
	XRI	1		AND COMPLEMENT IT
	MOV	L,A		REPLACE IN RESULT
* GET NEXT STRING
Q9	CALL	FE		GET NEXT CHARACTER
	STC			INDICATE CHARACTER EXPRESSION
	RZ			IF END OF LINE, QUIT
	CPI	'('		TEST FOR END OF NUMERIC SUBSTRING
	RZ			QUIT, INDICATING NUMBERIC RESULT
	CPI	'='		TEST FOR EQUAL,ASSIGNMENT, OR NOT EQUALS
	JNZ	CG1		NO, NO NEED TO TEST FURTHER
QTST	DCX	D		BACK UP TO PREVIOUS CHARACTER
	LDAX	D		GET CHARACTER
	MOV	B,A		SAVE FOR COMPARISON
	CPI	'='		TEST FOR '=='
	MVI	A,$81		INDICATE '=='
	JZ	CG1		CONTINUE
	MOV	A,B		GET CHARACTER BACK
	CPI	'-'		TEST FOR '-='
	MVI	A,$82		INDICATE '-='
	JZ	CG1		CONTINUE
	INX	D		ADVANCE BACK TO PREVIOUS CHARACTER
	MVI	A,'='		INDICATE '='
	JMP	CG1		CONTINUE
* CLEARS THE TEXT BUFFER
CLBF	LXI	H,XBF		GET ADDRESS OF BUFFER
	MVI	A,40		CLEAR FOR LENGTH OF 40
CL2	MVI	M,$FF		CLEAR TO NULL CHARACTER
	INX	H		NEXT POSITION IN BUFFER
	DCR	A		REDUCE COUNT OF REMAINING
	JNZ	CL2		KEEP GOING TILL WE ARE FINISHED
	RET
* COPY'S NEW BUFFER INTO OLD BUFFER
PUSHB	PUSH	D		SAVE POSITION IS SOURCE
	LXI	D,XBF		GET ADDRESS OF NEW BUFFER
	LXI	H,TB		GET ADDRESS OF OLD BUFFER
	MVI	B,40		COPY 40 CHARACTERS
PU1	LDAX	D		GET CHARACTER FROM NEW
	MOV	M,A		SAVE IN OLD
	INX	H		NEXT POSITION IN OLD
	INX	D		NEXT POSITION IN NEW
	DCR	B		REDUCE COUNT
	JNZ	PU1		KEEP GOING TILL 40 ARE MOVED
	POP	D		RESTORE POSITION IN SOURCE
	RET
* INDEXED CHARACTER VARIABLE, EXTRACT A SINGLE CHARACTER
CINDX	CALL	DOEXP		EVALUATE INDEX EXPRESSION
	MOV	A,L		GET INDEX VALUE
	PUSH	PSW		SAVE INDEX VALUE
	DCX	D		BACK UP TO VARIABLE NAME
	LDAX	D		GET VARIABLE NAME
	CPI	'@'		TEST FOR 'MAGIC' CHR$ VARIABLE
	JZ	CHR		IF SO, HANDLE SPECIAL CASE
	CALL	LTA		GET TEXT VARIABLE ADDRESS
	POP	PSW		GET INDEX BACK
	CPI	35		TEST FOR TOO BIG
	JNC	DIMERR		IF SO, TELL HIM HE SCREWED UP
	MOV	C,A		GET INTO A DOUBLE PAIR
	DAD	B		SO WE CAN DAD IT TO THE ADDRESS
	MOV	A,M		AND GET THE CHARACTER
FILBUF	LXI	H,XBF		ADDRESS OF TEXT BUFFER
	MOV	M,A		PLACE CHARACTER THERE
	INX	H		BUMP TO NEXT POSITION
	JMP	Q3		AND FILL WITH NULLS
*
* 'MAGIC' CHARACTER ARRAY, RETURNS CHARACTER WITH VALUE OF IT'S INDEX
*
CHR	POP	PSW		GET INDEX VALUE
	JMP	FILBUF		SAVE IN BUFFER AND PAD WITH NULLS
* I/O filler functions
SPACE	OUT	21
	RET
PMSG	MOV	A,M
	ANA	A
	RZ
	CALL	OUT
	INX	H
	CPI	$0D
	JNZ	PMSG
NL	OUT	22
	RET
IN	PUSH	B
	OUT	34
	MOV	A,B
	POP	B
	CPI	'a'
	RC
	CPI	'z'+1
	RNC
	ANI	$DF
	RET
OUT	PUSH	B
	MOV	B,A
	OUT	33
	MOV	A,B
	POP	B
	RET
CTRLC	PUSH	B
	OUT	35
	MOV	A,B
	POP	B
	CPI	$03
	RET
EXIT	MVI	B,0
	OUT	0
* END OF BASIC INTERPRETER CODE SECTION
	PAGE
*
**********************************************************************
*                          COMMAND TABLE
*
*   FORMAT IS:
*               COMMAND WORDS, HIGH BIT SET ON LAST CHARACTER
*               ADDRESS OF COMMAND PROCESSOR FOLLOWES
*               ENTRY OF HEX 00 INDICATES LAST ENTRY IN TABLE (DEFAULT)
*
**********************************************************************
*
* COMMANDS ALLOWED ONLY FROM WITHING A PROGRAM..
PTAB	STR	'NEX'
	DB	'T'+$80
	DW	NEXT
	STR	'THE'
	DB	'N'+$80
	DW	THEN
	STR	'GOSU'
	DB	'B'+$80
	DW	GOSUB
	STR	'RETUR'
	DB	'N'+$80
	DW	RETURN
	STR	'FO'
	DB	'R'+$80
	DW	FOR
	STR	'I'
	DB	'F'+$80
	DW	IF
DATCMD	STR	'DAT'
	DB	'A'+$80
	DW	RNEXT
	STR	'LI'
	DB	'F'+$80
	DW	LIF
* COMMANDS ALLOWED FROM BOTH A PROGRAM, AND INTERACTIVE KEYBOARD ENTRY
KTAB	STR	'GOT'
	DB	'O'+$80
	DW	GOTO
	STR	'LE'
	DB	'T'+$80
	DW	LET
	STR	'PRIN'
	DB	'T'+$80
	DW	PRINT
	STR	'US'
	DB	'R'+$80
	DW	USR
	STR	'REA'
	DB	'D'+$80
	DW	READ
	STR	'RE'
	DB	'M'+$80
	DW	REM
	STR	'DI'
	DB	'M'+$80
	DW	DIM
	STR	'RU'
	DB	'N'+$80
	DW	RUN
	STR	'ORDE'
	DB	'R'+$80
	DW	ORDER
	STR	'INPU'
	DB	'T'+$80
	DW	INPUT
	STR	'CLEA'
	DB	'R'+$80
	DW	CLEAR
	STR	'STO'
	DB	'P'+$80
	DW	STOP
	STR	'EN'
	DB	'D'+$80
	DW	INIT
	STR	'LIS'
	DB	'T'+$80
	DW	LIST
	STR	'NE'
	DB	'W'+$80
	DW	NEW
	STR	'SIZ'
	DB	'E'+$80
	DW	SIZE
	STR	'LOA'
	DB	'D'+$80
	DW	LOAD
	STR	'SAV'
	DB	'E'+$80
	DW	SAVE
	STR	'EXI'
	DB	'T'+$80
	DW	EXIT
	DB	0		UNRECOGNIZED COMMAND, ASSUME 'LET'
	DW	LET
*
***************************************************************
*                    STRINGS AND MESSAGES
***************************************************************
*
* ERROR MESSAGES..
*
DER	STRZ	'DIVIDE BY ZERO'   DIVIDE BY ZERO
IERMS	STR	'BAD DATA - RETRY' BAD RESPONSE TO INPUT STATEMENT
	DB	$0D
CSTK	STRZ	'NESTING'	INVALID FOR/NEXT, GOSUB/RETURN NESTING
LIN	STRZ	'LINE NUMBER'	GOTO, GOSUB, OR ORDER TO UNKNOWN LINE
NP	STRZ	'NO PROGRAM'	RUN OR SAVE EMPTY PROGRAM
INL	STRZ	' IN LINE '	INDICATES LINE ERROR WAS IN
SYN	STRZ	'SYNTAX'	DOES NOT FOLLOW SYNTAX RULES
DTXT	STRZ	'DATA'		BAD LINE OR DATA TYPE
OVM	STRZ	'DIMENSION'	TO MANY ARRAYS, ARGUMENT OUT OF RANGE
*
* INFORMATIONAL MESSAGES..
*
RDY	STR	'READY'		READY PROMPT
	DB	$0D
STMSG	STRZ	'STOP'		INDICATES PROGRAM STOPPED
EM	STRZ	' ERROR'	INDICATES ERROR OCCURED
SIMSG	STR	' BYTES'	DISPLAYED IN RESPONSE TO 'SIZE'
	DB	$0D
ENDIT	EQU	*
